I have files of data with the following format:
In column A, identifiers occur either doubly (e.g. 302_60) or singularly (e.g.310_58). Additional information is present in column B.
What I want to do is:
tag the rows that have single identifiers in column A with
TRUE/FALSE in Column C
for any TRUE tag, insert a line BELOW
copy into the inserted row the contents of the ENTIRE tagged row (here just columns A,B)
I solved #1 using =COUNTIF(A:A, A1)=1
I then wrote a VBA script to solve #2
Sub ins_below_and_copy()
Dim c As Range
For Each c In Range("C1:C100")
If InStr(1, c, "TRUE", vbTextCompare) > 0 Then
Rows(c.Offset(1, 0).Row & ":" & c.Offset(1, 0).Row).Insert Shift:=xlDown
End If
Next c
End Sub
Achieving the desired end result (#3)
seems simple enough, right? I have been trying .Copy and .Paste commands, but keep getting type-mismatch errors, an error that does not make sense to me (since I am not a competent VBA coder). Any ideas?
You have down all the hard work, filling in the gaps is easy. Select the two columns, HOME > Editing - Find & Select, Go To Special..., Blanks, OK, =, UP and Ctrl+Enter.
You can run this after you have your empty rows created.
Dim sheet As String
Dim lastRow As Long
sheet = "SheetName"
lastRow = Sheets(sheet).Range("A" & Rows.Count).End(xlUp).Row
For r = 2 To lastRow 'Assuming you have a Header Row
If Sheets(sheet).Cells(r, 1) = "" Then
Sheets(sheet).Cells(r - 1, 3) = "FALSE"
Sheets(sheet).Cells(r, 1) = Sheets(sheet).Cells(r - 1, 1)
Sheets(sheet).Cells(r, 2) = Sheets(sheet).Cells(r - 1, 2)
Sheets(sheet).Cells(r, 3) = Sheets(sheet).Cells(r - 1, 3)
End If
Next r
Related
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 doing data clean up. I collected data from multiple excel spreadsheets.
I am trying to achieve sorting on the basis on exact match i.e.
**Original dataset**
FirstName_Store1 FirstName_Store2 FirstName_Store3
Aat Cat Dat
Cat Bat Zat
Cot
Eat
**Result intended**
FirstName_Store1 FirstName_Store2 FirstName_Store3
Aat
Bat
Cat Cat
Cot
Dat
Eat
Zat
The reason I intended result because I want to find out which record to delete. I want to delete the value from Store1 which is not in store2 and store3.
Original dataset contains about 4000 records. Normal alphabet sorting doesn't display exact column value from Store1 side by side with Store2 and Store3.
Things I tried so far:
Match function Match (Store1,Store2:Store3,0) and the result was an error.
I also tried Vlookup, however, Vlookup doesn't do the sorting.
Personally, I think this is an XY Problem where you are trying to solve a problem that has little if anything to do with your actual issue.
The reason I intended result because I want to find out which record to delete. I want to delete the value from Store1 which is not in store2 and store3.
This situation should be solved easily by looping through each cell in the FirstName_Store1 column from bottom to top and performing an application.countif on the remaining columns.
With that said, here's one solution to the question you actually posed.
Sample data before sortAndSift sub procedure
sortAndSift code for public module code sheet
Option Explicit
Sub sortAndSift()
Dim i As Long, j As Long, m As Variant, n As Variant
With Worksheets("sheet6")
With .Cells(1, 1).CurrentRegion
With .Cells.Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
'store the original values
m = .Value2
End With
'put all values into column A
For i = 2 To .Columns.Count
With .Range(.Cells(2, i), .Cells(Rows.Count, i).End(xlUp))
.Parent.Cells(.Parent.Rows.Count, 1).End(xlUp).Resize(.Rows.Count, .Columns.Count).Offset(1, 0) = .Value
End With
Next i
End With
'reassert CurrentRegion since it probably changed
With .Cells(1, 1).CurrentRegion
With .Columns(1).Cells
'remove duplicates from column A
.RemoveDuplicates Columns:=1, Header:=xlYes
'sort column A
.Sort Key1:=.Columns(1), Order1:=xlAscending, _
Orientation:=xlTopToBottom, Header:=xlYes
End With
'put a copy of the expanded, de-duplicated and sorted column A
' in all other columns and make a copy of the values
With .Cells.Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
.FillRight
n = .Value2
End With
'remove values from each 'column' in the array that were not in the original
For i = LBound(n, 1) To UBound(n, 1)
For j = LBound(n, 2) To UBound(n, 2)
If IsError(Application.Match(n(i, j), Application.Index(m, 0, j), 0)) Then
n(i, j) = vbNullString
End If
Next j
Next i
End With
'put values back on the worksheet
.Cells(2, 1).Resize(UBound(n, 1), UBound(n, 2)) = n
End With
End Sub
Sample data after sortAndSift sub procedure
A unique list can easily be created by putting your data into a PivotTable (how though seems off topic for SO ref). The results may be Copy/Paste Special/Values, Remove Duplicates applied, sorted alphabetically and then placed in ColumnE, for example.
Then in F2 copied across and down to H8:
=IFERROR(IF(MATCH($E2,A:A,0),$E2),"")
Copy headings across.
Assumes Aat is in A2.
I have an excel worksheet with a lot of data that needs pruning.
Data is a organized by ID number with multiple rows attached to a given ID. For each unique ID, I need to to keep all rows with certain codes (which are found in column B). I also need to keep the rows immediately above the rows with the "keeper codes," provided such a row exists. If no such row exists, then I need to insert a blank row.*
For a given ID, if no "keeper code" is present, then all rows associated with the ID should be deleted. All rows not associated with a "keeper code" or immediately above a row with a "keeper code" should be deleted.
Probably best explained by screenshot. Data will be sorted by ID number as pictured.
*Inserting a blank row would be nice but if it makes the coding difficult then is not very necessary.
Thanks much!
Try this out,
Sub copyRows()
Dim i As Long, j As Long
Sheets.Add.Name = "newSheet"
Rows(1).Copy Sheets("newSheet").Cells(1, 1)
j = Sheets("newSheet").Cells(Rows.Count, 1).End(xlUp).Row + 1
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If InStr(Cells(i, 2), "Keep") > 0 And Cells(i, 1) = Cells(i - 1, 1) Then
Rows(i - 1).Copy Sheets("newSheet").Cells(j, 1)
Rows(i).Copy Sheets("newSheet").Cells(j + 1, 1)
ElseIf InStr(Cells(i, 2), "Keep") > 0 Then
Rows(i).Copy Sheets("newSheet").Cells(j, 1)
End If
j = Sheets("newSheet").Cells(Rows.Count, 1).End(xlUp).Row + 1
Next i
End Sub
If inserting empty rows is necessary you may have to work on that logic.
This macro creates a new sheet with the output.
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.
I've got a workbook where I have one worksheet which contains a lot of data.
My goal is to create a macro that inserts a formula in a separate sheet to copy the data from the first sheet. Lets call the first sheet "Numbers1" and the second sheet "TidyNumbers1".
In the sheet "TidyNumbers1" I want to loop through each cell from column A to M and rows 1 to 60. So I've got a macro that so far looks like this:
Sub updateFormulasForNamedRange()
Dim row, col, fieldCount As Integer
colCount = 13
RowCount = 60
For col = 1 To colCount
For row = 1 To RowCount
Dim strColCharacter
If col > 26 Then
strColCharacter = Chr(Int((row - 1) / 26) + 64) & Chr(((row - 1) Mod 26) + 65)
Else
strColCharacter = Chr(row + 64)
End If
Worksheets("TidyNumbers1").Cells(row, col).Formula = "=IF(Numbers1!E" & col & "<>0;Numbers1!" & strColCharacter & row & ";"")"
Next row
Next col
End Sub
But the formula is supposed to looks like this for Column A, row 2:
IF(Numbers1!E2<>0;Numbers1!A2;"")"
And the formula in Column A, row 3 should look like this:
IF(Numbers1!E3<>0;Numbers1!A3;"")"
Formula in Column B, row 2 should look like this:
IF(Numbers1!E2<>0;Numbers1!B2;"")"
In other words, the formula looks to see if the value in Column E, row % is anything but 0 and copies it if conditions are met.
But, I see that I need to translate my integer variable Row with letters, because the formula probably needs "A" instead of 1. Also, I get a 1004 error (Application-defined or object-defined error) if I just try to use:
Worksheets("Numbers1").Cells(row, col).Formula = "=IF(Numbers1!E" & row & "<>0;Numbers1!" & col & row & ";"")"
I clearly see that the integer row should be translated to letters, if that's possible. Or if anyone has any other suggestions that might work. Also, the 1004 error is unclear to me why happens. I can define a string variable and set the exact same value to it, and there's no error. So it's probably the formula bar that whines about it I guess?
Here is a former post of mine containing functions for conversion of column numbers to letters and vice versa:
VBA Finding the next column based on an input value
EDIT: to your 1004 error: Try something like this:
=IF(Numbers1!E" & row & "<>0,Numbers1!A" & row & ","""")"
(use ; instead of ,, and "" for one quotation mark in a basic string, """" for two quotation marks).
Would not it be easier to get the cell address with the Cells.Address function?
For example:
MsgBox Cells(1, 5).Address
Shows "$E$1"
Best Regards