Using loop and sum functions with Vlookup - vba

I've got a macro that essentially searches column C in Sheet1 for the value "Rec" and copies the corresponding value in column D, then pastes it into the last open cell in column B of Sheet2. It does just what it is supposed to do and is as follows:
Sub FindPasteGSVInNextCell()
Worksheets("Sheet2").Activate
Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
WorksheetFunction.VLookup("Rec", Sheet1.Range("C2:H25"), 2, False)
End Sub
I now want the code, instead of just searching for a single "Rec" value, to search for all rows with "Rec" in column C and to sum up all of their corresponding values in column D, then place that sum into Sheet2.
I am assuming that I need some kind of Do Until loop or something, but I am not exactly sure how to format it... I am a beginner with VBA, so any help would be greatly appreciated.

vlookup will not work as it will continue to only grab the first instance of "Rec".
On Sheet 2 list all the possible categories in column A then in column B1 put
= sumif(Sheet1!C:C,A1,Sheet1!D:D)
then copy down. This will Get you the totals by category.
If you want to use VBA, you will still need a list of categories setup somewhere, either hard coded or listed somewhere that you can loop through.
If your list was in column A on Sheet2 then you would:
dim ws as worksheet
set ws = Worksheets("Sheet2")
For each i in ws.range(ws.Range("A1"),ws.Range("A1").offset(xldown)).Cells
i.offset(,1) = WorksheetFunction.Sumif(Worksheets("Sheets1").Range("C:C"), _
i,Worksheets("Sheets1").Range("D:D"))
next i

Related

Copy rows based on cell value and paste on a new sheet

Check This
I need a help. I want to copy whole cell from A sheet name "Components" only if value in Column C is > 0 to a new Sheet name "Load list"
Can someone please give me the macro code for this?
on your new sheet you can add this condition the cell or range of cells:
=IF(Components!C5>0,Components!A5)
where C5 has thevalue to compare, and A5 has the value copy if the condition happens.
Right in my swing!
The formula given by #sweetkaos will work fine, in case you want to replicate the data as it is with blanks where data is not found.
I will imagine a slightly more complicated situation. I am assuming you want just one line in the next format as is shown in your image.
Also conveniently assuming the following:
a. both sheets have fixed start points for the lists
b. 2 column lists - to be copied and pasted, with second column having value
c. Continuous, without break source list
d. basic knowledge of vba, so you can restructure the code
Here is the code. Do try to understand it line by line. Happy Excelling!
Sub populateLoadList()
'declaring range type variables
Dim rngStartFirstList As Range, rngStartLoadList As Range
'setting values to the range variables
'you must change the names of the sheets and A1 to the correct starts of your two lists
Set rngStartFirstList = Worksheets("Name_of_your_fist_sheet").Range("A1")
Set rngStartLoadList = Worksheets("Name_of_your_second_sheet").Range("A1")
Do While rngStartFirstList.Value <> ""
If rngStartFirstList.Offset(1, 0).Value < 0 Then
Range(rngStartFirstList, rngStartFirstList.Offset(0, 1)).Copy
rngStartLoadList.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Set rngStartLoadList = rngStartLoadList.Offset(1, 0)
End If
Set rngStartFirstList = rngStartFirstList.Offset(1, 0)
Loop
End Sub
Basically what i want is ... if Value on C is >0 i want whole column 10 copied to that new sheet .... not only that cell

VBA Subroutine to fill formula down column

I have a current Sub that organizes data certain way for me and even enters a formula within the first row of the worksheet, but I am running into the issue of wanting it to be able to adjust how far down to fill the formula based on an adjacent column's empty/not empty status. For example, each time I run a report, I will get an unpredictable amount of returned records that will fill out rows in column A, however, since I want to extract strings from those returned records into different Columns, I have to enter formulas for each iteration within the next three columns (B, C, and D). Is there a way to insert a line that will evaluate the number of rows in Column A that are not blank, and then fill out the formulas in Columns B, C, and D to that final row? (I know that tables will do this automatically once information is entered in the first row, but for logistical reasons, I cannot use tables).
My current code that fills out the formula in Column B, Row 2 is:
Range("B2").Select
ActiveCell.FormulaR1C1 = "=MID(RC[-1],FIND(""By:"",RC[-1])+3,22)"
Thanks!
The formula that you actually need is
=IF(A2="","",MID(A2,FIND("By:",A2)+3,22))
instead of
=MID(A2,FIND("By:",A2)+3,22) '"=MID(RC[-1],FIND(""By:"",RC[-1])+3,22)"
This checks if there is anything in cell A and then act "accordingly"
Also Excel allows you to enter formula in a range in one go. So if you want the formula to go into cells say, A1:A10, then you can use this
Range("A1:A10").Formula = "=IF(A2="","",MID(A2,FIND("By:",A2)+3,22))"
Now how do we determine that 10? i.e the Last row. Simple
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long
'~~> Change the name of the sheet as applicable
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
'~~> Find Last Row in Col A
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("B2:B" & lRow).Formula = "=IF(A2="""","""",MID(A2,FIND(""By:"",A2)+3,22))"
End With
End Sub
More About How To Find Last Row
You can use this to populate columns B:D based on Column A
Range("B2:D" & Range("A" & Rows.Count).End(xlUp).Row).Formula = _
"=MID($A2,FIND(""By:"",$A2)+3,22)"

Excel, conditional formatting column base on comparing two columns

I have excel worksheet, with two sheets. First one (Worksheet 1) is big table (about 2000 rows), and in second (Worksheet2) I have only about 20 rows.
I need to check, if string in first column in each row in worksheet 1 is already in Worksheet 2, if so, make it green.
Thanks for solutions, both EXCEL or VBA will be appreciated :)
In worksheet 1 you need to create a new column (say column AA) which uses the formula VLOOKUP to find the same data (if it exists) in the other sheet. If is is not found VLOOKUP will return and error #N/A. So you formula will look soemthing like:
IF(ISERROR(VLOOKUP(A2, 'Sheet2'!$SA$1:$X$9999, 3, false)),"NOT FOUND","FOUND")
You would then add conditional formatting to sheet1 column A that references the value in your new column (AA) and sets the colour accordingly.
If you don't know how to use VLOOKUP or get the conditional formatting to work, there are plenty of resource on the internet to help you learn these. eg youtube channel ExcelisFun, WiseOwl.co.uk.
I hope this helps.
PS You do not need to use VBA to do this! In fact using a foumula can be preferable as if a single value changes it can cause the colours to be changed.
Harvey
If you want to use VBA, try as follow:
Public Sub findDuplicate()
Dim sh1row, sh2Row As Long
For sh1row = 1 To 20 'loop all row from Sheet2 (if more than 20, modify it)
For sh2Row = 1 To 2000 'loop all row from Sheet1 (if more than 2000, modify it)
'If A cell are equal
If Sheets("Sheet1").Range("A" & sh2Row) = Sheets("Sheet2").Range("A" & sh1row) Then
'Change background color to green.
Sheets("Sheet1").Range("A" & sh2Row).Interior.Color = RGB(0, 255, 0)
End If
Next sh2Row
Next sh1row
End Sub

select row based on cell value

I am working on a macro to move data from one sheet to another based on matching cell values.
Let's say I have 2 sheets, Sheet1 & Sheet2, respectively.
Sheet1 contains data that I wanted to be copied into Sheet2.
Sheet2 contains a value in column "C", and this value with have multiple matches in column "C" of
Sheet1 (which are already sorted and same values are grouped together).
My overall goal is to copy cells from Sheet1 to Sheet2 based on matching values in column "C". I want to insert these values one row below the row with matching column "C" values.
The difficulty lies in the fact that the range of values copied from Sheet1 to Sheet2 will differ with each different value in Column "c" of Sheet2, because there will be a different number of rows with respect to a particular cell value.
(I would show a simple picture for this, but it won't allow me to post a picture due to low post count - I can email this if needed for clarification)
I am okay with basic macro stuff and rely on the Macro Record for some stuff as well. But with my current knowledge and lack of the macro recorder's ability to make a macro like this, I am just stumped!
My request:
Help with macro that selects a range of cells based on matching cell values to copy
Help with inserting the copied range starting 1 row below the cell value of interest (cell value is row 2, insert cells starting at row 3)
Have this repeated for each value listed in Sheet2
I think I can figure the basic coding with this. If I can just get help with the particular string that does what I am looking for would be great! I am not trying to just be handed the answer, but I have been working on this issue for 8+hrs and can't find anything online that is similar to this...
This code assumes that you have sorted the data as you have in the example:
Sub transfer()
'If everything is sorted, you can do it like this:
Dim x, y 'x is the sheet1 row, y is the sheet2 row
y = 2 'they start at the same place x = 2, y = 2
For x = 2 To Sheets(1).Cells(Sheets(1).Rows.Count, "A").End(xlUp).Row
If Sheets(1).Cells(x, 1) = Sheets(2).Cells(y, 1) Then 'If the cell value matches
Sheets(1).Range("A" & x).Copy 'Copy the cell value from Sheet1
Sheets(2).Cells(y + 1, 1).Insert Shift:=xlDown 'And insert it below the Sheet2 Cell
'Then copy the rest of the data (columns C and D)
Sheets(1).Range("C" & x & ":D" & x).Copy Destination:=Sheets(2).Cells(y + 1, 2)
Else
x = x - 1 'We haven't found a match for this cell yet so check it again
End If
y = y + 1 'After incrementing y
Next x
End Sub
Sorry for slow reply - I can explain the code to you soon if need be!
Hope this helps! :)
I wrote this specifically for the example you gave me, so hopefully you are able to build upon this concept if your needs change.

Copying values in excel to another sheet, based on other values in the sheet

Ok, the question sounds pretty vague, but i will try to explain.
I am trying to copy certain cell values from one sheet into another sheet. The place it should copy it to, is determined by another value in the same sheet. For example:
Sheet1
4040-5056 ----- 4040-5056v1.7
3409-5793 ----- 3409-5793v4.3
Sheet2
4040-5056
3409-5793
Based on the first values you see, the second column of values in sheet1 should be copied in the corresponding cells in sheet2.
I have no idea how to do this, any help would be appreciated!
Thanks in advance
EDIT:
Sheet1 contains all values that have to be copied to the corresponding nvalues in the other sheets.
The values it has to correspond with are spread over 30 sheets or so, but all in the same document. In every sheet the values the code has to look for are all in the same column, so in every sheet is should look whether the value is the same in column A. VLOOKUP works, but is still a slow option, knowing that is handles over 36.000 rows. What the code should do, is copy the value of column B to one of the other sheets, if the value of column A corresponds with the value of column A in the other sheet.
I hope everyone can understand this explanation.
You can use the VLOOKUP function. No need to use VBA for this.
Sheet 1 :
A B C
1 4040-5056 4040-5056v1.7
2 3409-5793 3409-5793V4.3
3
Sheet 2:
A B C
1 4040-5056 =VLOOKUP(A1;Sheet1!$A$1:$B$2;2;FALSE)
2 3409-5793 =VLOOKUP(A2;Sheet1!$A$1:$B$2;2;FALSE)
3
Cell B1 will display "4040-5056v1.7", cell B2 "3409-5793V4.3"
Note that the last argument to VLOOKUP (here FALSE) is important in your case since the data is unsorted.
Another solution, using pure VBA:
Since there is a strong need for performance, I suggest using a dict object, as hinted in this SO question. The advantage of using a dictionary is that it is very fast to lookup, once it is built. So I expect my code to be very quick in the lookup. On the other hand, it will be slower in accessing the individual cells (through loops) than the builtin VLOOKUP.
Comparative performance, using a reference sheet fof 30'000 entries, and 3 lookup sheets with 30'000 lines each:
VLOOKUP : 600 seconds
VBA / dictionary : 3 seconds
so the performance is 200x better with VBA dictionary in this context.
Note : you have to add a reference to "Microsoft Scripting Runtime" (from the tools->Reference menu of the VBA window)
Note : this solution will not work if the data in the reference sheet is not contiguous, or if there are duplicates.
Sub FillReferences()
Dim dict As New Scripting.Dictionary
Dim myRow As Range
Dim mySheet As Worksheet
Const RefSheetName As String = "sheet1"
' 1. Build a dictionnary
Set mySheet = Worksheets(RefSheetName)
For Each myRow In mySheet.Range(mySheet.Range("A1").End(xlDown), mySheet.Range("A" & mySheet.Rows.Count).End(xlUp))
' Append A : B to dictionnary
dict.Add myRow.Value, myRow.Offset(0, 1).Value
Next myRow
' 2. Use it over all sheets
For Each mySheet In Worksheets
If mySheet.Name <> RefSheetName Then
' Check all cells in col A
For Each myRow In mySheet.Range(mySheet.Range("A1").End(xlDown), mySheet.Range("A" & mySheet.Rows.Count).End(xlUp))
' Value exists in ref sheet ?
If dict.exists(myRow.Value) Then
' Put value in col B
myRow.Offset(0, 1).Value = dict(myRow.Value)
End If
Next myRow
End If
Next mySheet
End Sub