Data Sheet
I have two workbooks with the same content. I am copying and pasting the amount values from one workbook sheet to another when the project number and division is the same. The amount has to be pasted in the row where there is a match. The issue I am facing is all the amounts are getting copied but not pasted near the respective match.
The code I have used is as follows:
ws1PRNum = "E" 'Project Number
ws1Div = "I" 'Division
ws2PRNum = "E" 'Project Number
ws2Div = "I" 'Division
'Setting first and last row for the columns in both sheets
ws1PRRow = 5 'The row we want to start processing first
ws1EndRow = wsSrc.UsedRange.Rows(wsSrc.UsedRange.Rows.count).Row
ws2PRRow = 5 'The row we want to start search first
ws2EndRow = wsDest.UsedRange.Rows(wsDest.UsedRange.Rows.count).Row
For i = ws1PRRow To ws1EndRow 'first and last row
searchKey = wsSrc.Range(ws1PRNum & i) & wsSrc.Range(ws1Div & i) 'PR line and number is Master Backlog
'if we have a non blank search term then iterate through possible matches
If (searchKey <> "") Then
For j = ws2PRRow To ws2EndRow 'first and last row
foundKey = wsDest.Range(ws2PRNum & j) & wsDest.Range(ws2Div & j) 'PR line and number in PR Report
'Copy result if there is a match between PR number and line in both sheets
If (searchKey = foundKey) Then
'Copying data where the rows match
wsDest.Range("AJ5", "AU1200").Value = wsSrc.Range("AJ5", "AU1200").Value
wsDest.Range("BB5", "BM1200").Value = wsSrc.Range("BB5", "BM1200").Value
wsDest.Range("BT5", "BU1200").Value = wsSrc.Range("BT5", "BU1200").Value
Exit For
End If
Next
End If
Next
This is the area that is causing an issue. As seen in the picture the amounts are pasted even in rows where the division and project number are empty. Any answer for the same would be highly appreciated as I am not well versed with VBA.
You can do this:
wsDest.Range("AJ" & j, "AU" & j).Value = wsSrc.Range("AJ" & i, "AU" & i).Value
'etc...
or with a bit less concatenation:
wsDest.Rows(j).Range("AJ1:AU1").Value = wsSrc.Rows(i).Range("AJ1:AU1").Value
Related
I have a sheet with some data and another sheet that is empty with just column headers. I wanted to copy data from the initial sheet into the other sheet based on a criteria where the region should be "Africa".
I used the code below which is copying the data but it is copying the first row from the initial sheet multiple times and not all the data rows where the region is "Africa". Here is a snippet of my code:
'Assigning the arrays to variables to return column index number
ws1Headers = getIndexes(ws1.Rows(4), mHeaders)
ws2Headers = getIndexes(ws2.Rows(2), soHeaders)
'Setting first and last row for the columns in both sheets
ws1SORow = 5 'The row we want to start processing first
ws1EndRow = ws1.UsedRange.Rows(ws1.UsedRange.Rows.count).Row
ws2SORow = 3 'The row we want to start search first
ws2EndRow = ws2.UsedRange.Rows(ws2.UsedRange.Rows.count).Row
'iterate through search terms
For i = ws1SORow To ws1EndRow 'first and last row
searchKey = ws1.Range("A" & i)
If (searchKey = "") Then
For j = ws2SORow To ws2EndRow 'first and last row
foundKey = ws2.Range("O" & j)
'Copy result if there is a match
If (foundKey = "Africa") Then
'Copying data where the headers match
For k = LBound(ws2Headers) To UBound(ws2Headers)
ws1.Cells(i, ws1Headers(k)) = ws2.Cells(j, ws2Headers(k))
Next k
Exit For
End If
Next
End If
Next
I have a function that gets the index of the headers and the header names are also defined which I have not included as it is a lot of code. Would highly appreciated any help for the query posted.
My situation is as follows. I have a list of around 2k student accounts and sort the information to a specific format that i can format to our new CRM. The way the data is presented initially makes that problematic.
As you can see on the first screenshot, every student's university choice is presented in a separate row. So if a student has chosen more than one university, data about it is stored in 2-6 rows (each student can select 1 to 6 universities) repeating his personalID, name, forename and DoB every line.
What I need to achieve is to remove repeating information and store all data about each student in one row per student(example on screenshot 2).
I have no idea how to achieve this using VBA. I was trying with IFs, loops and arrays but without any progress. I need help on how to accomplish that using VBA.
Please let me know if you need more information. I will try to explain it in more details if required.
Screenshot 1
Screenshot 2
EDIT: This is the part of the report. I am working on a macro that will format it to our needs and will give us more info about the student's accounts. That is why I am asking for help in VBA.
No need to use VBA for this. Power Query will help you better. Have a look here: https://excelgorilla.com/power-bi/power-query/aggregate-text-values-using-group-by/
This seems to work. I'm new to VBA and programming in general so it's possibly not the most efficient solution and can definitely be improved.
Instead of working with a blank sheet, it transforms the current data to the format you wanted. You can add field headings where you want.
Edit: It assumes that each Student has 5 universities in the list. The code can be adjusted to account for any number by just adjusting the target range dynamically.
Edit 2: I added the change to account for students who've entered any number of universities between 1 to 5. Let me know if this gets it done!
Sub ReArrange_Data()
Dim lrow As Long
lrow = Cells(Rows.Count, 1).End(xlUp).Row
Dim First As Integer
Dim Last As Integer
Dim test As Integer
Dim test1 As Integer
Dim student_range As Range
Dim student_rows As Integer
Dim target_range As Range
First = 2
For i = 2 To lrow
Last = First
If Cells(First, "D").Value = "" Then GoTo Break 'reached end of data
While Cells(Last, "D").Value = Cells(Last + 1, "D").Value
Last = Last + 1
Wend
If Last <> First Then 'check if mulitiple uni and build range
Set student_range = Range("E" & First & ":" & "E" & Last)
student_rows = student_range.Rows.Count
If student_rows = 5 Then
Set target_range = Range("E" & First & ":" & "I" & First)
ElseIf student_rows = 4 Then
Set target_range = Range("E" & First & ":" & "H" & First)
ElseIf student_rows = 3 Then
Set target_range = Range("E" & First & ":" & "G" & First)
ElseIf student_rows = 2 Then
Set target_range = Range("E" & First & ":" & "F" & First)
End If
Else
GoTo Skip 'student entered one uni, go to next loop
End If
target_range = Application.WorksheetFunction.Transpose(student_range.Value) 'row to column
Rows(First + 1 & ":" & Last).EntireRow.Delete
Skip: 'delete repeated entries
First = First + 1
Next i
Break:
End Sub
I am relatively new to Macros and VBA in Excel, so I need some guidance on how to solve my current issue.
The end goal of my project is to have a macro compare two sets of data organized into rows and columns (We'll say table A is the source data, and table B is based off of user input). Each row in table B should correspond to a row in table A, but they could be out of order, or there could be incorrect entries in table B.
My thought is that for the first row in each table, the macro would compare each cell left to right:
If Sheets("sheet1").Cells(2, 1) = Sheets("sheet2").Cells(2, 1) Then
If Sheets("sheet1").Cells(2, 2) = Seets("sheet2").Cells(2, 2)
Ect, ect.
My problem comes in when the Cell in table B does not match Table A.
First, I would want it to check B row 1 against the next row in A, and keep going throughout table A until it finds a "complete match" with all five columns of the row matching.
I've been trying to do this with Else if and For/Next staements
For row= 2 to 10
'if statements go here
Else If Sheets("sheet1").Cells(2, 1) <> Sheets("sheet2").Cells(2, 1)
Next row
I may be completely misunderstanding the syntax here, but I have yet to produce a situation where if the criteria is not met, it goes to the next row.
If no complete match is found, the last cell in table B row 1 that couldn't be matched should be highlighted.
Then regardless of whether a match was found or not, we would move to table B row 2, and start the whole process over.
So, I have the logic worked out (I think), where the comparison ifs would be inside a loop (or something) that would cycle through table A row by row. Then that whole process would be in another loop (or something) that would cycle through Table B.
At the end of the process, there would either be no highlighted cells showing that all entered data is correct, or cells would be highlighted showing data that do no match.
I am fairly certain that the cycling through table B is not the issue. Rather, I'm having difficulty getting the Macro to move to the next table A row if something doesn't match.
Please let me know if I need to elaborate on anything.
Thanks!
You could try:
Option Explicit
Sub test()
Dim Lastrow1 As Long, Lastrow2 As Long, i As Long, j As Long
Dim Str1 As String, Str2 As String
'Find the last row of sheet 1
Lastrow1 = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
'Find the last row of sheet 2
Lastrow2 = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row
For i = 2 To Lastrow1
'Let us assume that table has 3 columns. Merge 3 columns' values and create a string for each line
Str1 = Sheet1.Cells(i, 1).Value & "_" & Sheet1.Cells(i, 2).Value & "_" & Sheet1.Cells(i, 3).Value
For j = 2 To Lastrow2
'Let us assume that table has 3 columns. Merge 3 columns' values and create a string for each line
Str2 = Sheet2.Cells(j, 1).Value & "_" & Sheet2.Cells(j, 2).Value & "_" & Sheet2.Cells(j, 3).Value
'If both strings match a message box will appear
If Str1 = Str2 Then
MsgBox "Line " & i & " in table A match with line " & j & " in table B!"
Exit For
End If
Next j
Next i
End Sub
Sheet 1 structure:
Sheet 2 structure:
I am naive to macros. I have data in column A with 500 rows of data. Note some rows are blank in between. The data are image files names like (X0011#00.jpg). I need to rename them sequentially with user input. The user input must be only 400500. The new name must be like (400500_Image-1.jpg). The _Image-1, _Image-2 and so on must be generated automatically in sequence omitting blank rows.
See below how my data is displayed in column A and how I want it in column B.
I appreciate if anyone can provide macro for this.
Col A Col B
X0011#00.jpg 400500_Image-1.jpg
X0021#00.jpg 400500_Image-2.jpg
X0041#00.jpg 400500_Image-3.jpg
X0071#00.jpg 400500_Image-4.jpg
X0051#00.jpg 400500_Image-5.jpg
X0031#00.jpg 400500_Image-6.jpg
X0061#00.jpg 400500_Image-7.jpg
X0091#00.jpg 400500_Image-8.jpg
Thanks
Sub naming()
RowsToProcess = Range("A" & Rows.Count).End(xlUp).Row
j = 1
userInput = InputBox("Give me text")
For i = 1 To RowsToProcess
If Not Cells(i, 1).Value = "" Then
Cells(i, 2).Value = userInput & "_Image-" & j & ".jpg"
j = j + 1
End If
Next
End Sub
This macro creates column B as desired
I have an output exported to Excel which lists paths and filenames.
The paths and filenames are on separate rows however. If the path is consistent the filename is simply listed on the next row. Then the next path is on the next line followed by filenames ect.
C:\
file1.doc
C:\Windows\
file2.doc
file3.doc
file4.doc
C:\Windows\Folder\
file5.doc
I need to concatenate all the paths with the filenames. All paths begin with c:\ (or other drive letters which can be defined). For the example above the following output is required:
C:\file1.doc
C:\Windows\file2.doc
C:\Windows\file3.doc
C:\Windows\file4.doc
C:\Windows\Folder\file2.doc
Happy to have white spaces as these can be filtered out in Excel.
Thanks,
Jono
VBA approach:
Sub test()
Dim ws As Worksheet
Dim iRow As Long
Dim i As Integer
Dim strFirstValue, strScndValue, strNewValue, strValue As String
Dim startFlag, endFlag As Boolean
Set ws = Sheets(1)
iRow = ws.Range("A1048576").End(xlUp).Row
strFirstValue = ws.Range("A2:A2")
strFirstValue = "": strScndValue = ""
startFlag = False
strFirstValue = ws.Range("A2:A2")
For i = 2 To iRow 'Assuming you have header, otherwise change 2 to 1
If endFlag Then
strFirstValue = ws.Range("A" & i & ":A" & i)
End If
strValue = strFirstValue
strScndValue = ws.Range("A" & i + 1 & ":A" & i + 1)
If InStr(strValue, ":") > 0 Then
startFlag = True
If Not strScndValue = "" Then
If Not InStr(strScndValue, ":") > 0 Then
strNewValue = strFirstValue & strScndValue
ws.Range("B" & i + 1 & ":B" & i + 1) = strNewValue
endFlag = False
Else
endFlag = True
End If
End If
End If
Next i
'To remove the row with drive info
For i = 2 To iRow
strValue = ws.Range("B" & i & ":B" & i)
If strValue = "" Then
ws.Range("B" & i & ":B" & i).EntireRow.Delete
End If
Next i
Set ws = Nothing
End Sub
Before:
After:
With data in column A, this macro will put the results in column B:
Sub dural()
Dim s As String, J As Long, r As Range
J = 1
For Each r In Intersect(ActiveSheet.UsedRange, Range("A:A"))
s = r.Text
If s = "" Then Exit Sub
If Right(s, 1) = "\" Then
pref = s
Else
Cells(J, 2).Value = pref & s
J = J + 1
End If
Next r
End Sub
Non-VBA solution, which will require some helper columns:
Assuming your data is in column A, and you don't care about sorting the results / having blanks within the results:
Put this in cell B2 and copy down [I recommend you have a header row for row 1]
=if(mid(A2,2,2)=":/",A2,B1)
This puts the new file path in column B, and if it's not a new file path (doesn't start with "x:/"), it takes the file path from column the previous cell.
In cell C2, copied down:
=if(mid(A2,2,2)=":/","",B2&A2)
This checks if the line you're on is a file path or a file name. If it's a file name, it adds the file name to the file path and displays as a single string. If it's a filepath, it returns a blank.
Alternatively you could save a tiny bit of processing time by using columns B-D instead of B-C. Some calculation is wasted here because we are doing the same check ("does cell A2 include ':/'?") twice, so excel needs to calculate it twice. Like so:
Put this in Cell B2:
=mid(a2,2,2)=":/"
Returns TRUE if the cell in column A is a filepath; returns FALSE if the cell in column A is a filename. Then put this in cell C2 and copy down:
=if(B2,A2,B1)
Works same as above, but uses the test already defined in cell B2. Put this in cell D2 and copy down:
=if(B2,"",B2&A2)
If you do want to sort your results column, there's just 2 extra steps (this is kind of unnecessary, but if you want to present / print your data in some format, you will need to either do this or manually copy + paste values):
Add an extra column to the right of the final column from my above response. Here, you want to check to see whether your current row is a new filepath + filename, or if it is blank (meaning column A was a filepath). I will assume you used my second option above, using columns B-D.
In column E, starting at E2 and copied down:
=if(B2,B1,B1+1)
If B2 is TRUE, the row is a filepath, and doesn't create a new filename + filepath. Therefore, we can keep the last counter. Otherwise, add a new counter.
In column F, starting at F2 and copied down:
=if(row()-1>max(E:E),"",index(D:D,match(row()-1,E:E,0)))
This looks at your results column, column D, which is unsorted and contains blanks. If the current row number in column F (minus 1 for the header row) is no bigger than the biggest counter in column D, it returns the matching item for that row number from column D.
Hope this helps you in similar situations in the future.