Macro for "Sumif/Vlookup"

[shahji]

Hello,

i am working on a macro where i need to copy data from a sheet to a different sheet in the same workbook. i normally use "vlookup" or "Sumif" or "Sumproduct" formulae to do the job. the datas is quite large and it takes ages to refresh the data when i use "Sumif" or "Vlookup". i am looking for a macro which could replace these formulae. I have included a short example of the database.

Sheet1 has the data and it should be pasted on Sheet2 by looking in Sheet1 column "Code" should be used as a condition. for every "700" there are a few value and they should be taken from Sheet1 and pasted in Sheet2 corresponding to the "Client". same with other "Codes" and i might need to add the Balances in sum instances.

thank you in advance for your help,

Shah

[cguan_77]

you're looking for a specific value in sheet1 to pasted in sheet2?
or you need to do calculation first in sheet1 and after doing the calculation you'll find for a specific result and copy over to sheet2?
is it what you're trying to do or what?

[shahji]

well thank you for your reply,

I would not have to calculate anything as all the values are already in the database. i would need to find a specific result and copy over to sheet2. i hope this helps,

thanks,

Shah

[cguan_77]

try this..
it will find a specific value..then copy the whole rows to sheet2.. just modify it to suit your needs.. hope it helps..

Dim x as boolean
Dim x1 as string

x = Cells.Find(What:="Data to Find", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate

if x = true then

x1 =activecell.row

rows(x1).copy

sheet2.range("1:1").pastespecial

else 

msgbox "Data not found"

end if

[shahji]

thank you cguan,

the code works fine.
i was wondering if i could run a loop on this as the code stops after looking at the first value in sheet1 and copies it to sheet2.

Also is it possible to give it more than one codition lets say it looks in sheet2 column1 for a value and copy a value from sheet1 column 3 corresponding to the value in sheet2 column1 and a condition in sheet1 column2.

i hope i have explained it ok.

thank you

[cguan_77]

yes it is possible to look for a value in sheet column1 and copy a value from sheet1 column3 but what you mean by "and a condition in sheet1 column2"?

[shahji]

thank for getting back to me,

well i have attached a small example.

sheet1 has three columns "Client", "Code" and "Balance" and sheet2 has two columns "Client"and "Balance".

i want to copy data from Sheet1 "Balance" to Sheet2 "Balance". the data should correspond to the "client" column.
there are many entries in "Code" but i am just interested in a few. lets say "Code" is "700" and i want to copy "balance" for Client "0014" and past it in sheet2 "Balance" corresponding to the client.

i hope this will help,

btw i was able to loop the macro but as it is not dynamic it just keeps on going through the sheets and copies nothing.

thank you for your help.

[cguan_77]

hi shahji, try this, hope it helps... ;)

Sub Macro1()

Dim x, y As Boolean
Dim x1, x2, x3 As String
Dim y1, y2, y3 As String
    
'declare the data to find
y1 = "700"
y2 = "0014"

    'activate sheet1 and search
    Sheets("Sheet1").Select
    Columns("b:b").Select
    x = Selection.Find(What:=y1, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        
    'check if data is found
    If x = True Then
    
     x1 = ActiveCell.Row
     x2 = Cells(x1, 1).Value
     x3 = ActiveCell.Value
    
    End If
    
    'check if data match together if not search again
    If x2 <> y2 Then
    
        y = Cells.FindNext(After:=ActiveCell).Activate
    
          Else
     
    End If
 
  'if data found found then copy
  If y = True Then
        y3 = ActiveCell.Row
        Rows(y3).Select
        Rows(y3).Copy
  End If
    
   'select sheet2 and search the data
   Sheets("Sheet2").Select
   Columns("a:a").Select
   y = Selection.Find(What:=y2, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate

  ' found then paste the data from sheet1
  If y = True Then
   x1 = ActiveCell.Row
   Cells(x1, 1).Select
   Selection.PasteSpecial
  
End If

End Sub

[shahji]

hey Cguan,

i have tried the above but it copies the macro to sheet2 rather than any data.
any ideas why is that?

thanks

[cguan_77]

try this.. :)

Sub Macro1()

Dim x, y As Boolean
Dim x1, x2, x3 As String
Dim y1, y2 As String
    
'declare the data to find
y1 = "700"
y2 = "0014"

    'activate sheet1 and search
    Sheets("Sheet1").Select
    Columns("b:b").Select
    x = Selection.Find(What:=y1, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        
    'check if data found then copy
    If x = True Then
    
     x1 = ActiveCell.Row
     x3 = ActiveCell.Value
     Rows(x1).Select
     Selection.Copy
     
    End If
      
      
   'select sheet2 and search the data
   Sheets("Sheet2").Select
   Columns("a:a").Select
   y = Selection.Find(What:=y2, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate

   'found then paste the data from sheet1
  If y = True Then
   x1 = ActiveCell.Row
   Cells(x1, 1).Select
   Selection.PasteSpecial
  
End If

End Sub

[shahji]

hey Cguan,

thank you for the reply. the macro works but copies the entire row to sheet2.

nearly there but not quite. two more things
1) if i need to look for a whole column instead of y2 = "0014" for example y2 = A:A in sheet 2
2)I need to copy the value in Sheet1 Column C only not the entire row.

thanks

[cguan_77]

hey Cguan,

thank you for the reply. the macro works but copies the entire row to sheet2.

nearly there but not quite. two more things
1) if i need to look for a whole column instead of y2 = "0014" for example y2 = A:A in sheet 2
2)I need to copy the value in Sheet1 Column C only not the entire row.

thanks

try this, hope it helps.

Sub Macro1()

Dim x, y As Boolean
Dim x1, x2, x3 As String
Dim y1, y2 As String
Dim z1, z2 As String

'declare the data to find
'y1 = "700"
'y2 = "0014"
y1 = InputBox("Enter data to search in sheet 1 column a")
y2 = InputBox("Enter data to search in sheet 2 column a")

'activate sheet1 and search
Sheets("Sheet1").Select
Columns("b:b").Select
x = Selection.Find(What:=y1, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

'check if data found then copy
If x = True Then

x1 = ActiveCell.Row
x3 = ActiveCell.Value
'Rows(x1).Select
z1 = Cells(x1, 3).Select
Selection.Copy

End If

'select sheet2 and search the data
Sheets("Sheet2").Select
Columns("a:a").Select
y = Selection.Find(What:=y2, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

'found then paste the data from sheet1
If y = True Then
x1 = ActiveCell.Row
Cells(x1, 2).Select
Selection.PasteSpecial

End If

End Sub

[shahji]

hey Cguan,

thanks for getting back to me.

after a long research i have found the following macro which copies data based on a condition and runs a loop as well.

Sub CopyData()
Dim lRow As Long, x As Long, y As Long, z As Long

lRow = Sheets("sheet1").range("A65535").End(xlUp).Row

y = 2

For x = 2 To lRow
If Sheets("sheet1").range("B" & x) = "700" Then
Sheets("sheet2").range("B" & y).Value = Sheets("sheet1").range("C" & x).Value

y = y + 1
End If
Next
End Sub

one problem remains.
i would like the macro to past value in front of the corresponding client. as from my previous example client "0014" has a "700" code. this macro picks up all the balances which are "700" but it does not match them with the right "client". any idea how i can do that. as both sheets have client codes in Column A.

thank you very much.

shah

[cguan_77]

try this:

Sub Macro2()


Dim lRow As Long, x As Long, y As Long, z As Long, i As Long
Dim xx(5) As String 'increase the array to any number you want

lRow = Sheets("sheet1").Range("A65535").End(xlUp).Row

y = 0

For x = 2 To lRow
If Sheets("sheet1").Range("B" & x) = "700" And Sheets("sheet1").Range("a" & x) = "0014" Then
 
 y = y + 1
 
 xx(y) = Sheets("sheet1").Range("C" & x).Value
    
End If
Next



For z = 1 To lRow

If Sheets("sheet2").Range("a" & z) = "0014" Then
 i = i + 1
  Sheets("sheet2").Range("b" & z).Value = xx(i)

End If
Next

End Sub

[shahji]

thanks man,

we are nearly there. the macro works for one client but it does not pick the balances for remaining clients. lets say 0014 is the first client and 0027A is the 2nd client and 0027A2 is the third client.
the macro stops at first client (0014) and pastes the value.
i want it to keep looking in sheet2 column A and get the balances from sheet1 column C until there are no more clients in Sheet2 column A.

thanks

[cguan_77]

check my previous post..i implement the input box..then just put a loop.. like msgbox yes, no.. :)

[ragsy.r]

Hi Cguan,

I have a similar request to build a macro for the spreadsheet to pull data from the master sheet with a few parameters in particular. If you can help me, I will send you the sample data.

Looking forward for your reply.

-Ragsy

[cguan_77]

ok, try sending your data...maybe guys around here also got an idea on what you want to achieve...

and also post details on what you want to do :)

Welcome to DaniWeb!!!

[shahji]

Hello everyone,

I am posting a Vlookup Macro. thanks to Brian Baulsom. I hope this will help everyone. If you have any questions please let me know.

'=========================================================
'- GENERIC LOOKUP MACRO TO
'- FIND A VALUE IN ANOTHER WORKSHEET
'- AND RETURN A VALUE FROM ANOTHER COLUMN
'=========================================================
'- select the cell containing the first search value
'- and run this macro from there.
'- can be set to continue down the column
'- [** need to make changes below as required **]
'- Brian Baulsom May 2005
'==========================================================
Dim MyValue As Variant
Dim FromSheet As Worksheet
Dim LookupColumn As Integer
Dim FromRow As Long
Dim FromColumn As Integer
'-
Dim ToSheet As Worksheet
Dim StartRow As Long
Dim LastRow As Long
Dim ActiveColumn As Integer
Dim ReturnColumnNumber
Dim ToRow As Long
Dim FoundCell As Object

'=============================================================
'- MAIN ROUTINE
'=============================================================
Sub DO_LOOKUP()
Application.Calculation = xlCalculationManual
'----------------------------------------------------------
'- LOOKUP SHEET [**AMEND AS REQUIRED**]
Set FromSheet = Sheets("S6values")
LookupColumn = 1 ' look for match here
FromColumn = 2 ' return value from here
'-----------------------------------------------------------
'- ACTIVE SHEET
Set ToSheet = Sheets("MonthlyFigures")
ActiveColumn = 1
StartRow = 6
'-------------------------------------------------------------
'- COMMENT OUT UNWANTED LINE, UNCOMMENT THE OTHER
'- ..............................[** FOR MULTIPLE ROWS **]
'LastRow = ToSheet.Cells(65536, ActiveColumn).End(xlUp).Row
'-
'- ..............................[** FOR A SINGLE VALUE **]
LastRow = ToSheet.Cells(65536, ActiveColumn).End(xlUp).Row
'-------------------------------------------------------------
'- COLUMN NUMBER TO PUT RETURNED VALUE [**AMEND AS REQUIRED**]
ReturnColumnNumber = 2 ' column number
'-------------------------------------------------------------
'- loop through each row (which may be only 1)
For ToRow = StartRow To LastRow
MyValue = ToSheet.Cells(ToRow, ActiveColumn).Value
FindValue
Next

End Sub
'== END OF PROCEDURE ====================================================

'========================================================================
'- FIND VALUE
'========================================================================
Private Sub FindValue()
Set FoundCell = _
FromSheet.Columns(LookupColumn).Find(MyValue, LookIn:=xlValues)
If FoundCell Is Nothing Then

Else
FromRow = FoundCell.Row
'- transfer additional data.
ToSheet.Cells(ToRow, ReturnColumnNumber).Value = _
FromSheet.Cells(FromRow, FromColumn).Value
End If
End Sub
'=========================================================================******************************************************