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
Related
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
I need to split cells into multiple rows without moving the cells in the ID column. The problem is that the list can be endless and the number of category's can be different and alose their can be information in column C which also have to stay on the same line as the ID cell.
Current and wanted results
https://imgur.com/a/rslXx4A
You could use a macro to loop through your info and print it in the new columns. Something like:
Sub delimit()
Dim cat As Range, c As Range, i As Long, nxt As Long
Set cat = ActiveSheet.Range(Range("B2"), Range("B65000").End(xlUp))
For Each c In cat
arr = Split(c.Value, ";")
For i = 0 To UBound(arr)
nxt = Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Row
If i = 0 Then Range("D" & nxt).Value = c.Offset(0, -1)
Range("E" & nxt).Value = arr(i)
Next i
Next c
End Sub
The core thing we are using here is Split() which will turn a string into an array.
Syntax : Split ( expression [,delimiter] [,limit] [,compare] )
We loop through the category list, set to column "B", and make a new array for each cell.
Then we print this array in the column we want, in this example column "E".
But first, we print out the ID number in column "D", since we are currently aiming for that row.
If you also want to copy column "C" like we do "A", simply change the IF accordingly.
From
If i = 0 Then Range("D" & nxt).Value = c.Offset(0, -1)
to
If i = 0 Then
Range("D" & nxt).Value = c.Offset(0, -1)
Range("F" & nxt).Value = c.Offset(0, 1)
End If
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 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.
Good afternoon all,
I have an issue where I have users who have multiple bank account details. I need to try and create a new row for each employee who has more than one bank account, with the second bank account being allocated a new row.
Employee Number User ID BSB Account number
10000591 WOODSP0 306089,116879 343509,041145273
10000592 THOMSOS0 037125 317166
I need it to look something like this:
Employee Number User ID BSB Account number
10000591 WOODSP0 306089 343509
10000591 WOODSP0 116879 041145273
10000592 THOMSOS0 037125 317166
Any thoughts? Your input is greatly appreciated!
Screenshots are here to demonstrate:
Right click on the tab and choose "View Code"
Paste this code in:
Sub SplitOnAccount()
Dim X As Long, Y As Long, EmpNo As String, UserID As String, BSB As Variant, AccNo As Variant
Range("F1:I1") = Application.Transpose(Application.Transpose(Array(Range("A1:D1"))))
For X = 2 To Range("A" & Rows.Count).End(xlUp).Row
EmpNo = Range("A" & X).Text
UserID = Range("B" & X).Text
BSB = Split(Range("C" & X).Text, ",")
AccNo = Split(Range("D" & X).Text, ",")
For Y = LBound(AccNo) To UBound(AccNo)
Range("F" & Range("F" & Rows.Count).End(xlUp).Row).Offset(1, 0).Formula = EmpNo
Range("G" & Range("G" & Rows.Count).End(xlUp).Row).Offset(1, 0).Formula = UserID
Range("H" & Range("H" & Rows.Count).End(xlUp).Row).Offset(1, 0).Formula = BSB(Y)
Range("I" & Range("I" & Rows.Count).End(xlUp).Row).Offset(1, 0).Formula = AccNo(Y)
Next
Next
End Sub
Close the window to go back to excel
Press ALT-F8
Choose SplitOnAccount and click run.
Note, this is going to populate the split data to rows F to I, make sure there is nothing in there. If there is post back and we can change it.
Also format columns F - I as text before you run it or Excel will strip leading zeros off as it will interpret it as a number.
Here is another sub that appears to perform what you are looking for.
Sub stack_accounts()
Dim rw As Long, b As Long
Dim vVALs As Variant, vBSBs As Variant, vACTs As Variant
With ActiveSheet '<-define this worksheet properly!
For rw = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
vVALs = .Cells(rw, 1).Resize(1, 4).Value
vBSBs = Split(vVALs(1, 3), Chr(44))
vACTs = Split(vVALs(1, 4), Chr(44))
If UBound(vBSBs) = UBound(vBSBs) Then
For b = UBound(vBSBs) To LBound(vBSBs) Step -1
If b > LBound(vBSBs) Then _
.Rows(rw + 1).Insert
.Cells(rw - (b > LBound(vBSBs)), 1).Resize(1, 4) = vVALs
.Cells(rw - (b > LBound(vBSBs)), 3).Resize(1, 2).NumberFormat = "#"
.Cells(rw - (b > LBound(vBSBs)), 3) = CStr(vBSBs(b))
.Cells(rw - (b > LBound(vBSBs)), 4) = CStr(vACTs(b))
Next b
End If
Next rw
End With
End Sub
I was originally only going to process the rows that had comma delimited values in columns C and D but I thought that processing all of them would allow the macro to set the Text number format and get rid of the Number as text error warnings and keep the leading zero in 041145273.
You Can definitely use Power Query to transform the data to generate new rows using split column option.
Check this article it explains the process in detail.
Load Data in Power Query section of excel.
Create an Index (Not required step)
Use Split column function with advance options and split them into new rows.
Save this result into new table for your use.
I did it myself and it worked like a charm.
A formula solution:
Delimiter: Can be a real delimiter or an absolute reference to a cell containing only the delimiter.
HelperCol: I have to use a helper column to make it work. You need to give the column letter.
StartCol: The column letter of the first column containing data.
SplitCol: The column letter of the column to be splitted.
Formula1: Used to generate the formula for the first column not to be splitted. You can fill this formula down and then fill to right.
Formula2: Used to generate the formula for the column to be splitted(only support split one column).
Formula3: Used to generate the formula for the Helper column.
(If the title of the column to be splitted contains the delimiter, you must change the first value of the helper column to 1 manually.)
Formula1:=SUBSTITUTE(SUBSTITUTE("=LOOKUP(ROW(1:1),$J:$J,A:A)&""""","$J:$J","$"&B2&":$"&B2),"A:A",B3&":"&B3)
Formula2:=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE("=MID($M$1&LOOKUP(ROW(A1),$J:$J,F:F)&$M$1,FIND(""艹"",SUBSTITUTE($M$1&LOOKUP(ROW(A1),$J:$J,F:F)&$M$1,$M$1,"&"""艹"",ROW(A2)-LOOKUP(ROW(A1),$J:$J)))+1,FIND(""艹"",SUBSTITUTE($M$1&LOOKUP(ROW(A1),$J:$J,F:F)&$M$1,$M$1,""艹"",ROW(A2)-LOOKUP(ROW(A1),$J:$J)+1))-FIND(""艹"",SUBSTITUTE($M$1&LOOKUP(ROW(A1),$J:$J,F:F)&$M$1,$M$1,""艹"",ROW(A2)-LOOKUP(ROW(A1),$J:$J)))-1)&""""","$M$1",IF(ISERROR(INDIRECT(B1)),""""&B1&"""",B1)),"$J:$J","$"&B2&":$"&B2),"F:F",B4&":"&B4)
Formula3:=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE("=SUM(E1,LEN(B1)-LEN(SUBSTITUTE(B1,$H$1,"""")))+1","B1",B4&1),"$H$1",IF(ISERROR(INDIRECT(B1)),""""&B1&"""",B1)),"E1",B2&1)
Helper must filled one row more than the data.
How to use:
Copy the formula generated by the above three formula.
Use Paste Special only paste the value.
Make the formula into effect.
Fill the formula.
Bug:
Numbers will be converted to Text. Of course you can remove the &"" at the end of the formula, but blank cells will be filled with 0.
ps. This method may by very hard to comprehend. But once you master it, it can be very useful to solve relative problems.