SOLVED

Need help with excel vba

%3CLINGO-SUB%20id%3D%22lingo-sub-1444498%22%20slang%3D%22en-US%22%3ENeed%20help%20with%20excel%20vba%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1444498%22%20slang%3D%22en-US%22%3EI%20have%20two%20sheets%20-sheet1%20and%20sheet2%2C%20sheet%202%20need%20to%20fetch%20the%20larger%20number%20of%20sheet1%20from%20column%20b%20and%20also%20column%20e%20cell%20value%20for%20the%20first%20time.%20This%20process%20has%20to%20repeat%20to%20paste%20in%20new%20next%20line%20available%20in%20sheet2%20when%20ever%20macro%20runned%20.%20Got%20stucked.%20Please%20help%20me%20out.%20This%20is%20my%20code%2C%20please%20suggest%20to%20modify%3CBR%20%2F%3E%3CBR%20%2F%3ESub%20oi()%3CBR%20%2F%3EWorksheets(%22Sheet1%22).Select%3CBR%20%2F%3EWorksheets(%22Sheet1%22).Activate%3CBR%20%2F%3EDim%20c%20As%20Long%3CBR%20%2F%3Ea%20%3D%20ThisWorkbook.Sheets(%22Sheet1%22).Cells(Rows.Count%2C%202).End(xlUp).Row%3CBR%20%2F%3Ec%20%3D%20Application.WorksheetFunction.Large(Worksheets(%22Sheet1%22).range(%22B11%3AB96%22)%2C%201)%20%2F%2Fto%20find%20largest%20number%20from%20column%20b%20from%20range%2011%20to%2096%3CBR%20%2F%3E%3CBR%20%2F%3EWorksheets(%22Sheet1%22).Select%3CBR%20%2F%3EWorksheets(%22Sheet1%22).Activate%3CBR%20%2F%3EFor%20i%20%3D%2011%20To%20a%3CBR%20%2F%3EIf%20Worksheets(%22Sheet1%22).Cells(i%2C%202).Value%20%3D%20c%20Then%3CBR%20%2F%3EWorksheets(%22Sheet1%22).Cells(i%2C%206).Copy%20%2F%2Fneed%20to%20copy%206%20th%20column%20value%20of%20largest%20value%20c%3CBR%20%2F%3EWorksheets(%22Sheet2%22).Activate%3CBR%20%2F%3Eb%20%3D%20Worksheets(%22Sheet2%22).Cells(Rows.Count%2C%201).End(xlUp).Row%20%2B%201%3CBR%20%2F%3E%3CBR%20%2F%3EWorksheets(%22Sheet2%22).Cells(b%20%2B%201%2C%202).Select%3CBR%20%2F%3EActiveSheet.Paste%3CBR%20%2F%3E%3CBR%20%2F%3EEnd%20If%3CBR%20%2F%3ENext%3CBR%20%2F%3E%3CBR%20%2F%3EApplication.CutCopyMode%20%3D%20True%3CBR%20%2F%3E%3CBR%20%2F%3EWorksheets(%22Sheet2%22).Activate%3CBR%20%2F%3E%3CBR%20%2F%3EEnd%20Sub%3CBR%20%2F%3E%3CBR%20%2F%3E%3C%2FLINGO-BODY%3E%3CLINGO-LABS%20id%3D%22lingo-labs-1444498%22%20slang%3D%22en-US%22%3E%3CLINGO-LABEL%3EExcel%3C%2FLINGO-LABEL%3E%3C%2FLINGO-LABS%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1444530%22%20slang%3D%22en-US%22%3ERe%3A%20Need%20help%20with%20excel%20vba%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1444530%22%20slang%3D%22en-US%22%3EHelp%20me%20out%20guys%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1445203%22%20slang%3D%22en-US%22%3ERe%3A%20Need%20help%20with%20excel%20vba%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1445203%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F600385%22%20target%3D%22_blank%22%3E%40Suma_shankar%3C%2FA%3E%26nbsp%3BAre%20you%20doing%20this%20in%20Excel%20or%20in%20Access%3F%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EIf%20it's%20in%20Excel%2C%20you'll%20probably%20get%20better%20response%20if%20you%20post%20this%20in%20the%20appropriate%20Excel%20forum.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1445296%22%20slang%3D%22en-US%22%3ERe%3A%20Need%20help%20with%20excel%20vba%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1445296%22%20slang%3D%22en-US%22%3EThanks%20for%20your%20suggestion.%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1445429%22%20slang%3D%22en-US%22%3ERe%3A%20Need%20help%20with%20excel%20vba%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1445429%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F600385%22%20target%3D%22_blank%22%3E%40Suma_shankar%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3Eattach%20ur%20file%20here.%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1445550%22%20slang%3D%22en-US%22%3ERe%3A%20Need%20help%20with%20excel%20vba%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1445550%22%20slang%3D%22en-US%22%3E%3CP%3EInstead%20of%20programmatically%20copying%20and%20pasting%20you%20can%20use%20VBA%20to%20write%20to%20a%20new%20cell%20directly.%26nbsp%3B%20The%20following%20code%20eliminates%20the%20script%20from%20bouncing%20from%20sheet%20to%20sheet%20and%20reduces%20the%20number%20of%20steps.%26nbsp%3B%20I'm%20sure%20others%20could%20write%20an%20even%20more%20simplified%20version%20but%20this%20should%20do%20the%20trick%20for%20you.%3C%2FP%3E%3CPRE%20class%3D%22lia-code-sample%20language-visual%22%3E%3CCODE%3ESub%20oi()%0ADim%20a%2C%20c%20As%20Long%0ADim%20d%2C%20b%20As%20Range%0AWith%20Worksheets(%22Sheet1%22).Range(%22B11%3AB96%22)%20%20'Using%20a%20with%20block%20just%20helps%20to%20keep%20code%20cleaner%20when%20your%20using%20an%20object%20multiple%20times%0A%20%20%20%20c%20%3D%20Application.WorksheetFunction.Large(.Cells%2C%201)%20'Your%20formula%20to%20find%20the%20largest%20value%20in%20the%20range%20(B11%3AB96)%0A%20%20%20%20Set%20b%20%3D%20.Find(c).Offset(0%2C%204).Cells%0A%20%20%20%20'Instead%20of%20copying%20the%20value%20we%20will%20assign%20b%20to%20be%20the%20cell%20that%20contains%20your%20reference%20using%20the%20highest%20value%0A%20%20%20%20'For%20the%20reference%20I%20used%204%20(Column%20F)%20since%20I%20wasn't%20sure%20which%20column%20you%20were%20referring%20to%0A%20%20%20%20'Your%20reference%20will%20be%20-1%20for%20column%20A%2C%200%20for%20column%20B%2C%201%20for%20C%2C%202%3DD%2C%203%3DE%2C%204%3DF%2C%20...%0AEnd%20With%0ASet%20d%20%3D%20Application.Sheets(%22Sheet2%22).UsedRange%20%20'This%20populates%20a%20range%20equal%20to%20all%20the%20cells%20in%20use%20on%20sheet2%20(like%20Ctrl%2BA)%0Aa%20%3D%20d.Cells.Rows.Count%20%2B%20d.Row%20%20'This%20gives%20us%20the%20total%20number%20of%20rows%20plus%20the%20row%20the%20range%20starts%20from%20to%20give%20us%20the%20next%20empty%20row%0AWorksheets(%22Sheet2%22).Activate%20%20%20'Moving%20on%20over%20to%20sheet2%0AWorksheets(%22Sheet2%22).Cells(a%2C%202).Select%20'Locate%20the%20next%20cell%20in%20column%202%20and%20select%20it%0ASelection.Value2%20%3D%20b%20%20%20%20'Make%20that%20cell%20equal%20to%20reference%20cell%20using%20the%20largest%20value%20you%20found%0AEnd%20Sub%3C%2FCODE%3E%3C%2FPRE%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1445938%22%20slang%3D%22en-US%22%3ERe%3A%20Need%20help%20with%20excel%20vba%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1445938%22%20slang%3D%22en-US%22%3EDone%20it%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1446016%22%20slang%3D%22en-US%22%3ERe%3A%20Need%20help%20with%20excel%20vba%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1446016%22%20slang%3D%22en-US%22%3EOkay..%20I%20saw%20that.%20But%20the%20code%20only%20write%20top%203%20values.%20if%20you%20want%20change%20top%20any%20value%20or%20you%20should%20choose%20my%20code.%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1446027%22%20slang%3D%22en-US%22%3ERe%3A%20Need%20help%20with%20excel%20vba%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1446027%22%20slang%3D%22en-US%22%3EI%20want%20it%20for%20only%20top%203%20values%20and%20I%20will%20choose%20your%20code%20itself%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1445940%22%20slang%3D%22en-US%22%3ERe%3A%20Need%20help%20with%20excel%20vba%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1445940%22%20slang%3D%22en-US%22%3EThanks%20for%20your%20reply.%3CBR%20%2F%3EUr%20code%20is%20working%20fine%20sir.%20I%20just%20modified%20ur%20code%20by%20adding%20to%20find%20two%20more%20larger%20numbers%20from%20the%20same%20range%20and%20pasting%20it%20into%20another%20sheet.%3CBR%20%2F%3ESub%20oi()%3CBR%20%2F%3EDim%20a%2C%20c%2C%20e%2C%20g%20As%20Long%3CBR%20%2F%3EDim%20d%2C%20b%2C%20f%2C%20h%20As%20Range%3CBR%20%2F%3EWith%20Worksheets(%22NIFTY%22).Range(%22B11%3AB96%22)%3CBR%20%2F%3Ec%20%3D%20Application.WorksheetFunction.Large(.Cells%2C%201)%3CBR%20%2F%3ESet%20b%20%3D%20.Find(c).Offset(0%2C%204).Cells%3CBR%20%2F%3Ee%20%3D%20Application.WorksheetFunction.Large(.Cells%2C%202)%3CBR%20%2F%3ESet%20f%20%3D%20.Find(e).Offset(0%2C%204).Cells%3CBR%20%2F%3Eg%20%3D%20Application.WorksheetFunction.Large(.Cells%2C%203)%3CBR%20%2F%3ESet%20h%20%3D%20.Find(g).Offset(0%2C%204).Cells%3CBR%20%2F%3EEnd%20With%3CBR%20%2F%3E%3CBR%20%2F%3ESet%20d%20%3D%20Application.Sheets(%22Sheet2%22).UsedRange%3CBR%20%2F%3Ea%20%3D%20d.Cells.Rows.Count%20%2B%20d.Row%3CBR%20%2F%3EWorksheets(%22Sheet2%22).Activate%3CBR%20%2F%3EWorksheets(%22Sheet2%22).Cells(a%2C%202).Select%3CBR%20%2F%3ESelection.Value2%20%3D%20b%3CBR%20%2F%3E%3CBR%20%2F%3EWorksheets(%22Sheet2%22).Cells(a%2C%203).Select%3CBR%20%2F%3ESelection.Value2%20%3D%20f%3CBR%20%2F%3E%3CBR%20%2F%3EWorksheets(%22Sheet2%22).Cells(a%2C%204).Select%3CBR%20%2F%3ESelection.Value2%20%3D%20h%3CBR%20%2F%3EEnd%20Sub%3CBR%20%2F%3E%3CBR%20%2F%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1446956%22%20slang%3D%22en-US%22%3ERe%3A%20Need%20help%20with%20excel%20vba%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1446956%22%20slang%3D%22en-US%22%3EThanks%20a%20lot%20sir%20%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F307537%22%20target%3D%22_blank%22%3E%40xspJody%3C%2FA%3E%3C%2FLINGO-BODY%3E
Highlighted
Occasional Contributor
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

10 Replies
Highlighted
Help me out guys
Highlighted

@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.

 

 

Highlighted
Thanks for your suggestion.
Highlighted

@Suma_shankar 

 

attach ur file here.

Highlighted

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
Highlighted
Done it
Highlighted
Best Response confirmed by Suma_shankar (Occasional Contributor)
Solution
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

Highlighted
Okay.. I saw that. But the code only write top 3 values. if you want change top any value or you should choose my code.
Highlighted
I want it for only top 3 values and I will choose your code itself
Highlighted
Thanks a lot sir @xspJody