VBA: Getting row data when a cell is a specific value
I'm fairly new to VBA - most of my programming is done in PHP - and I haven't touched anything VB-like since VB5. I've been asked to learn VBA for work and am doing fairly well - but have gotten stuck.
Our spreadsheet has 3 sheets (4, including the one we're outputting to) and we're trying to do comparisons between them. I've got most of the work figured out, but am stuck on one. In Sheet2, there's a column (QuickID) that references values in specific rows in Sheet3. Here's a CSV of some sample:
Sheet2
Adam,3,1234
Bonnie,6,1237
Chris,19,1236
Donna,3,1235
Sheet3
1234,208,16,B
1235,7,39,B
1236,19,6,A
1237,35,12,C
So, Column 3 in Sheet2 and Column 1 in Sheet 3 are the QuickID values I mentioned.
What I'm attempting to do is build an output sheet, Sheet4, where I can pull the values of both Sheet2 and Sheet3 together, matching them up by QuickID.
I'm sure there's an easy way to do this - I just can't find it.
Any help would be apprec开发者_StackOverflow中文版iated. Thanks.
Suppose you want to do the following:
Sheet2 Sheet3 Sheet4
A B C A B C D A B C D E F
1 Adam 3 1234 1234 208 16 B Adam 3 1234 208 16 B
2 Bonnie 6 1237 1235 7 39 B -----> Bonnie 6 1237 7 39 B
3 Chris 16 1236 1236 19 6 A Chris 16 1236 19 6 A
4 Donna 3 1235 1237 35 12 C Donna 3 1235 35 12 C
This code will help achieve that:
Sub CreateMatchedOutput()
Dim quickIDSht2 As Range, quickIDSht3 As Range, id As Range
Dim rng1 As Range, rng2 As Range
Dim matchIndex As Long, cnt As Long
Set quickIDSht2 = Worksheets("Sheet2").Range("C1:C4") //quickID column in Sheet2
Set quickIDSht3 = Worksheets("Sheet3").Range("A1:A4") //quickID column in Sheet3
cnt = 1
For Each id In quickIDSht2
Set rng1 = Worksheets("Sheet2").Range("A" & id.Row & ":C" & id.Row) //Get all data in row from Sheet2
matchIndex = WorksheetFunction.Match(id, quickIDSht3, 0) //match quickID in sheet2 to data in Sheet3
Set rng2 = Worksheets("Sheet3").Range("B" & matchIndex & ":D" & matchIndex) //Get all data in Sheet3 based on rowindex given by match above
rng1.Copy Destination:=Worksheets("Sheet4").Range("A" & cnt)
rng2.Copy Destination:=Worksheets("Sheet4").Range("D" & cnt)
cnt = cnt + 1
Next id
End Sub
Does this help?
You don't need VBA for this, just a couple of Excel lookup functions, Match and Index. To do this, copy your headers and data from Sheet2 into Sheet4. Assuming you have a header in Row 1 and your data starts in Row 2, you'd enter the following in E2 on Sheet4:
=INDEX(Sheet2!A$2:A$5,MATCH($A2,Sheet2!$C$2:$C$5,0))
Then drag over to column F and down as necessary.
Edit: This does the same thing in code, with an option to copy over the formulas as values.
Sub MergeData()
Dim wbWithData As Excel.Workbook
Dim ws2 As Excel.Worksheet
Dim ws3 As Excel.Worksheet
Dim ws4 As Excel.Worksheet
Dim lngLastRow As Long
Dim rngToFill As Excel.Range
Dim cell As Excel.Range
Set wbWithData = ThisWorkbook 'Change this as needed
With wbWithData
Set ws2 = .Worksheets("Sheet2")
Set ws3 = .Worksheets("Sheet3")
On Error Resume Next
Application.DisplayAlerts = False
'delete if already exists
.Worksheets("Sheet4").Delete
On Error GoTo 0
Application.DisplayAlerts = True
ws3.Copy after:=ws3
Set ws4 = ActiveSheet
ws4.Name = "Sheet4"
End With
With ws4
lngLastRow = .Range("A" & .Rows.Count).End(xlUp).Row
Set rngToFill = .Range("E2:F" & lngLastRow)
rngToFill.Formula = "=INDEX(Sheet2!A$2:A$5,MATCH($A2,Sheet2!$C$2:$C$5,0))"
'do the following to paste results as values
rngToFill = rngToFill.Value2
End With
End Sub
Sub test()
'Application.ScreenUpdating = False
Sheets("Sheet2").Select
Rows("5:10000").Select 'keep only source data
Selection.Delete Shift:=xlUp
Dim vTotal_Row, vCurrent_row, vCurrent_column_p, vCurrent_column_d As Integer
vCurrent_row_S = 1 'First row of source data
vCurrent_row_d = 1 'First row of destination data
vCurrent_column_S = 3 'First column of source data
vCurrent_column_d = 1 'First column of destination data
Do While vCurrent_row_S <= 6 'last row number of source data
i = 1
vCurrent_column_p = 1
vCurrent_column_d = 1
Application.StatusBar = "Total row: 396" & " Processing row:" & vCurrent_row_P
Do While i <= 4
If Sheets("Sheet2").Cells(vCurrent_row_S, vCurrent_column_S) = Sheets("Sheet3").Cells(i, vCurrent_column_S - 2) Then
Sheets("Sheet4").Cells(vCurrent_row_d, vCurrent_column_d).Value = Sheets("Sheet3").Cells(i, vCurrent_column_S - 2)
Sheets("Sheet4").Cells(vCurrent_row_d, vCurrent_column_d + 1).Value = Sheets("Sheet3").Cells(i, vCurrent_column_S - 1)
Sheets("Sheet4").Cells(vCurrent_row_d, vCurrent_column_d + 2).Value = Sheets("Sheet3").Cells(i, vCurrent_column_S)
Sheets("Sheet4").Cells(vCurrent_row_d, vCurrent_column_d + 3).Value = Sheets("Sheet3").Cells(i, vCurrent_column_S + 1)
Sheets("Sheet4").Cells(vCurrent_row_d, vCurrent_column_d + 4).Value = Sheets("Sheet2").Cells(vCurrent_row_S, vCurrent_column_S - 2)
Sheets("Sheet4").Cells(vCurrent_row_d, vCurrent_column_d + 5).Value = Sheets("Sheet2").Cells(vCurrent_row_S, vCurrent_column_S - 1)
Sheets("Sheet4").Cells(vCurrent_row_d, vCurrent_column_d + 6).Value = Sheets("Sheet2").Cells(vCurrent_row_S, vCurrent_column_S)
End If
i = i + 1
Loop
vCurrent_row_d = vCurrent_row_d + 1
'Increase current row of source data
vCurrent_row_S = vCurrent_row_S + 1
Loop
MsgBox "complete"
End Sub
精彩评论