Forum Discussion

Suma_shankar's avatar
Suma_shankar
Copper Contributor
Jun 06, 2020

Need help with excel vba

I have two sheets -sheet1 and sheet2, sheet 2 need to fetch the larger number of sheet1 from column b and also column e cell value for the first time. This process has to repeat to paste in new next line available in sheet2 when ever macro runned . Got stucked. Please help me out. This is my code, please suggest to modify

Sub oi()
Worksheets("Sheet1").Select
Worksheets("Sheet1").Activate
Dim c As Long
a = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Row
c = Application.WorksheetFunction.Large(Worksheets("Sheet1").range("B11:B96"), 1) //to find largest number from column b from range 11 to 96

Worksheets("Sheet1").Select
Worksheets("Sheet1").Activate
For i = 11 To a
If Worksheets("Sheet1").Cells(i, 2).Value = c Then
Worksheets("Sheet1").Cells(i, 6).Copy //need to copy 6 th column value of largest value c
Worksheets("Sheet2").Activate
b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row + 1

Worksheets("Sheet2").Cells(b + 1, 2).Select
ActiveSheet.Paste

End If
Next

Application.CutCopyMode = True

Worksheets("Sheet2").Activate

End Sub

excel
  • Suma_shankar's avatar
    Suma_shankar
    Jun 07, 2020
    Thanks for your reply.
    Ur code is working fine sir. I just modified ur code by adding to find two more larger numbers from the same range and pasting it into another sheet.
    Sub oi()
    Dim a, c, e, g As Long
    Dim d, b, f, h As Range
    With Worksheets("NIFTY").Range("B11:B96")
    c = Application.WorksheetFunction.Large(.Cells, 1)
    Set b = .Find(c).Offset(0, 4).Cells
    e = Application.WorksheetFunction.Large(.Cells, 2)
    Set f = .Find(e).Offset(0, 4).Cells
    g = Application.WorksheetFunction.Large(.Cells, 3)
    Set h = .Find(g).Offset(0, 4).Cells
    End With

    Set d = Application.Sheets("Sheet2").UsedRange
    a = d.Cells.Rows.Count + d.Row
    Worksheets("Sheet2").Activate
    Worksheets("Sheet2").Cells(a, 2).Select
    Selection.Value2 = b

    Worksheets("Sheet2").Cells(a, 3).Select
    Selection.Value2 = f

    Worksheets("Sheet2").Cells(a, 4).Select
    Selection.Value2 = h
    End Sub

    • George Hepworth's avatar
      George Hepworth
      Steel Contributor
      Jun 06, 2020

      Suma_shankar Are you doing this in Excel or in Access?

       

      If it's in Excel, you'll probably get better response if you post this in the appropriate Excel forum.

       

       

  • xspJody's avatar
    xspJody
    Copper Contributor
    Jun 06, 2020

    Instead of programmatically copying and pasting you can use VBA to write to a new cell directly.  The following code eliminates the script from bouncing from sheet to sheet and reduces the number of steps.  I'm sure others could write an even more simplified version but this should do the trick for you.

    Sub oi()
Dim a, c As Long
Dim d, b As Range
With Worksheets("Sheet1").Range("B11:B96")  'Using a with block just helps to keep code cleaner when your using an object multiple times
    c = Application.WorksheetFunction.Large(.Cells, 1) 'Your formula to find the largest value in the range (B11:B96)
    Set b = .Find(c).Offset(0, 4).Cells
    'Instead of copying the value we will assign b to be the cell that contains your reference using the highest value
    'For the reference I used 4 (Column F) since I wasn't sure which column you were referring to
    'Your reference will be -1 for column A, 0 for column B, 1 for C, 2=D, 3=E, 4=F, ...
End With
Set d = Application.Sheets("Sheet2").UsedRange  'This populates a range equal to all the cells in use on sheet2 (like Ctrl+A)
a = d.Cells.Rows.Count + d.Row  'This gives us the total number of rows plus the row the range starts from to give us the next empty row
Worksheets("Sheet2").Activate   'Moving on over to sheet2
Worksheets("Sheet2").Cells(a, 2).Select 'Locate the next cell in column 2 and select it
Selection.Value2 = b    'Make that cell equal to reference cell using the largest value you found
End Sub
    • Suma_shankar's avatar
      Suma_shankar
      Copper Contributor
      Jun 07, 2020
      Thanks for your reply.
      Ur code is working fine sir. I just modified ur code by adding to find two more larger numbers from the same range and pasting it into another sheet.
      Sub oi()
      Dim a, c, e, g As Long
      Dim d, b, f, h As Range
      With Worksheets("NIFTY").Range("B11:B96")
      c = Application.WorksheetFunction.Large(.Cells, 1)
      Set b = .Find(c).Offset(0, 4).Cells
      e = Application.WorksheetFunction.Large(.Cells, 2)
      Set f = .Find(e).Offset(0, 4).Cells
      g = Application.WorksheetFunction.Large(.Cells, 3)
      Set h = .Find(g).Offset(0, 4).Cells
      End With

      Set d = Application.Sheets("Sheet2").UsedRange
      a = d.Cells.Rows.Count + d.Row
      Worksheets("Sheet2").Activate
      Worksheets("Sheet2").Cells(a, 2).Select
      Selection.Value2 = b

      Worksheets("Sheet2").Cells(a, 3).Select
      Selection.Value2 = f

      Worksheets("Sheet2").Cells(a, 4).Select
      Selection.Value2 = h
      End Sub

Resources