I have 2 excel sheets, where I would like to find and replace values, however I would like to have multiple replace values take the spot of one match value.
Sheet 1: Sheet 2:
Match Value Match Value New Value
28045000 28045000 28051560
39162010 28045000 28056549
39269000 39162010 39596000
All Match Values in sheet 1 are unique, while match values in sheet 2 may have duplicates because they correspond to multiple new values. So, if the match value in sheet 1 and sheet 2 are the same, then I want to replace the match value in sheet 1 with all of the new values that correspond to the match value. Sheet 1 after the replacements have been made should look like this:
Sheet 1:
Match Value
28051560
28056549
39596000
39269000
So as we can see, 28045000 was replaced by 2 values, 28051560 and 28056549 in 2 separate cells, while 39162010 was replaced by 39596000, while 39269000 which did not have a match value in sheet 2, remained the same.
I would typically do this manually, but there are about 30,000 rows of data, some with over to 10 values matching a single match value. I have the following code, however, this does not properly replace the match value with all of the new values. Is there a way to get Excel to search through the entire range of both sheets and make the proper changes automatically?
Sub multiFindNReplace()
Dim myList, myRange
Set myList = Sheets("sheet 1").Range("A1:A5000")
Set myRange = Sheets("sheet2").Range("A1:A5000")
For Each cel In myList.Columns(1).Cells
myRange.Replace what:=cel.Value, replacement:=cel.Offset(0, 1).Value
Next cel
End Sub
I would do it like this:
The macro just loop through the first sheet and compare it with the second sheet. If it matches, it replace the value in the first, add c+1 and go on with searching. Because the orginal value is replaced then, the orignal value is stored in d, if it find a second match it dones't replace it because of c+1, it goes to the else clause, insert a row and put the value in the new row. Like this it loops through the whole column on sheet1.
PS: I hope you can understand it, i didn't had that much time, will edit later for more readability.
Update:
So here we go again, i added the maxrow counter and overcomment it for a easy understanding.
Update 2:
Now with While-Loop because of for-loops doesn't regconize limit changes
Sub CompareLoop()
'Iterator Worksheet 1, is the counter for the ws1 column
Dim iWS1 As Integer
'Iterator Worksheet 2, is the counter for the ws1 column
Dim iWS2 As Integer
'Switch New Row, is the switch if the next value need a new row
Dim sNR As Integer
'Maximal Row Count, need to be extend when new rows are added
Dim MaxRows As Integer
'valueHolder, is the holder for the orginal value, the orginal value might be replaced on the sheet
Dim valueHolder As Long
'Worksheet1
Dim ws1 As Worksheet
'Worlsheet2
Dim ws2 As Worksheet
Set ws1 = ActiveWorkbook.Worksheets("table1")
Set ws2 = ActiveWorkbook.Worksheets("table2")
'Set iWS1 to the first row
iWS1 = 1
'Get MaxRows
MaxRows = ws1.Cells(Rows.Count, 1).End(xlUp).Row
'Loop through the Rows on WS1 setting switch to 0 and store the value from the ws1 row in the holder
While iWS1 <= MaxRows
sNR = 0
valueHolder = ws1.Cells(iWS1, 1).Value
'Loop through the Rows on WS2, searching for a value that match with the value from ws1
For iWS2 = 1 To ws2.Cells(Rows.Count, 1).End(xlUp).Row
'When it matches, then look if there was already a match with the value, if not replace it on the ws1 and increase the sNr to 1
If valueHolder = ws2.Cells(iWS2, 1).Value Then
If (sNR < 1) Then
ws1.Cells(iWS1, 1).Value = ws2.Cells(iWS2, 2).Value
sNR = sNR + 1
'When the sNR is already > 0, increase the Iterator for the ws1 that he will point on the new line
'increase the maxrows because we got one more soon, finally insert the new row and store the value from ws2 in it
Else
iWS1 = iWS1 + 1
MaxRows = MaxRows + 1
Range(ws1.Cells(iWS1, 1), ws1.Cells(iWS1, 1)).EntireRow.Insert
ws1.Cells(iWS1, 1).Value = ws2.Cells(iWS2, 2)
End If
End If
Next iWS2
iWS1 = iWS1 + 1
Wend
End Sub
Assuming Columns start at A are contiguous and are labelled, in Sheet 1, B2 and copied down to suit:
=IF(ISERROR(MATCH(A2,'Sheet 2'!A:A,0)),A2,"")
Copy range containing all values from Sheet 1 Column B and Paste Special, Values below last entry in Sheet 2 Column B.
Copy Sheet 2 Column B into A1 of Sheet 1 and filter to remove blanks in Column A. Delete Sheet 1 Column B.
Related
Given the lack of elegance with the data
the record sheet continues for many MANY rows, each entry having its own set of identical headings
I was hoping to just extract the data from rows 7, 14 and so on, then populate the data into a simple table to be used on the 'Protocol Summary' form, then sort them all into alphanumeric order based on the data that is in the A column so they all become grouped by 'Event Type'.
Because the potential data that could be under the 'Event Type' heading can vary a lot (generally has the format of [number 1-32/letter/number 1-30] but can also be all letters, with a few thousand possibilities, I thought it might be easier to filter the other lines OUT, given they don't change. I would love to redesign the table, but unfortunately it's not my table so I have to work with what I'm given.
Thanks for your time.
This will loop over your sheet up to the last used row, starting from Row 7 and stepping 7 rows each iteration.
Within each iteration, each cell in the row is written into an array which is then written to another sheet ready for sorting (however you want to do that).
This code is sample and may not work by copy/paste.
I have written this in the Sheet1 code module, so Me refers to ThisWorkbook.Sheets("Sheet1").
I have made this from a blank workbook and did not rename any sheets therefore you will need to make adjustments to any sheet references to match your appropriate sheet names.
The code will only reference columns A, B and C in the TargetRow (I only tested with 3 columns of data as I don't know your working range). I'll reference what to update to extend this after the code block.
Currently the array is put back into Sheet2 starting from cell A2. This is assuming row 1 contains table headers as this will write the data directly into the table format. Naturally if you want to change where the data is written, change the cell it is written to (when writing an array to sheet, you only need to define the top left cell of the range it is written to, Excel works out the rest based on the size and dimensions of the array).
Sub WriteEverySeventhRowToAnotherSheet()
Dim SeventhRowCount As Long
Dim myArray() As Variant
Dim lastrow As Long
Dim TargetCell As Variant
Dim TargetRow As Range
Dim ArrFirstDimension As Long
Dim ArrSecondDimension As Long
lastrow = Me.Range("A" & Me.Rows.Count).End(xlUp).Row
ReDim myArray(1 To lastrow / 7, 1 To 3)
ArrFirstDimension = 1
ArrSecondDimension = 1
'------------------Loop over every 7th row and enter row data to array---------------
For SeventhRowCount = 7 To lastrow Step 7
Set TargetRow = Me.Range("A" & SeventhRowCount & ":C" & SeventhRowCount)
For Each TargetCell In TargetRow
If Not ArrSecondDimension > UBound(myArray) Then
myArray(ArrFirstDimension, ArrSecondDimension) = TargetCell
'Debug.Print TargetCell
ArrSecondDimension = ArrSecondDimension + 1
End If
Next TargetCell
ArrFirstDimension = ArrFirstDimension + 1
ArrSecondDimension = 1
Set TargetRow = Nothing
Next SeventhRowCount
'---------------------Write array to another sheet------------------
Dim Destination As Range
Set Destination = ThisWorkbook.Sheets("Sheet2").Range("A2")
Destination.Resize(UBound(myArray, 1), UBound(myArray, 2)).Value = myArray
End Sub
To extend the number of columns the loop will write to the array, change the following instance of C to the correct column letter (in the below line the range is set from Column A to Column C):
Set TargetRow = Me.Range("A" & SeventhRowCount & ":C" & SeventhRowCount)
Also change the 2nd dimension of the Array to match the number of the Column set above (i.e Column E = 5 and Column L = 13 etc.) - You need to replace the number 3 with the correct number.
ReDim myArray(1 To lastrow / 7, 1 To 3)
I have a list of computers and users.
Column A is the names of the computers (with duplicates).
Column C is a list of the users that I was able to join together in a
CSV file format.
Example:
In column A, in rows 1 and 2 we have computer1.
In columnc C, row 1 it has user1 and in row 2 it has user1,user2.
I need to keep only the largest row for each computer so that instead of having Computer1 with user1 I only have computer1 with user1,user2.
You could use match to test for an error for all cells below and then use that as a True/False result. Here's a formula I built:
=IF(ISERROR(MATCH(A2,A3:A$999999,0)),"Use Me","ignore")
This Macro would also work, if you wanted to delete them:
Sub KillRows()
Dim ws As Worksheet: Set ws = ActiveSheet
Dim killRNG As Range
Set killRNG = ws.Rows(Rows.Count)
Dim i As Long
For i = 1 To ws.UsedRange.Rows.Count
If Application.WorksheetFunction.CountIf(Range(ws.Cells(i + 1, 1), ws.Cells(Rows.Count, 1)), ws.Cells(i, 1)) > 0 Then
Set killRNG = Union(killRNG, ws.Rows(i))
End If
Next i
killRNG.EntireRow.Delete
End Sub
In my Excel file I have two sheet and below is the Structure.
If one or multiple values under "TC iD Column" matches with first Column in sheet 2 then it ids in Sheet one will replace with URL or displayed in the next column in sheet.
Sheet 1:
Sheet 2:
[]
try this:
sub jain()
Dim ws1 as Worksheet, ws2 as Worksheet, xrow1 as long, xrow2 as long, xcol as Int, ID as string
set ws1 = Worksheets("Sheet1")
set ws2 = Worksheets("Sheet2")
xrow1 = 2
xrow2 = 2
xcol = 3
do until ws1.Cells(xrow1, 2) = ""
do until ws2.Cells(xrow2, 2) = ""
ID = ws2.Cells(xrow2, 1).value
if InStr(1, ws1.Cells(xrow1, 2), ID) > 0 Then
ws1.Cells(xrow1, xcol).value = ws2.Cells(xrow2, 1).value
xcol = xcol + 1
else:
End if
xrow2 = xrow2 + 1
loop
xrow2 = 2
xcol = 3
loop
end sub
basically this will loop through each cell and check if there is an id match. when there is one, the InStr function will result in a value of 1, making the if trigger which copies the hyperlink from sheet2 to the cells to the right of the ID column in sheet1.
I made this assuming that on sheet1, the TC ID column is the second column, that the hyperlink column in sheet2 is the second column (and that sheet has headers), and that all the cells to the right of the TC ID column on sheet1 are blank. If any of these assumptions are wrong I will need to change values in the code for it to work properly.
I didn't test this so if you get errors let me know and I can fix it.
I need to paste a single row of data from one worksheet to another n number of times. I want to take the input n through an input box.
Are there any pointers on how to do this using VBA?
Here's a bare bones macro. Note you'll need to tweak the sheet names are required.
Sub test()
Dim dataWS As Worksheet, copyToWS As Worksheet
Dim copyRow&, noCopies&, copySheetLastRow&, i&
Set dataWS = Sheets("Sheet1")
Set copyToWS = Sheets("Sheet2") ' Change these as required.
copySheetLastRow = copyToWS.Cells(copyToWS.Rows.Count, 1).End(xlUp).Row
If copySheetLastRow > 1 Then
copySheetLastRow = copySheetLastRow + 1
End If
copyRow = InputBox("What row would you like to copy?")
noCopies = InputBox("How many times do you want it copied?")
For i = 1 To noCopies
With dataWS
copyToWS.Rows(copySheetLastRow).Value = .Rows(copyRow).Value
End With
copySheetLastRow = copyToWS.Cells(copyToWS.Rows.Count, 1).End(xlUp).Row + 1
Next i
End Sub
It takes the chosen Row from your data WS, and puts it in the next available row in your "copy to" worksheet.
Edit: Per your question, this code ensures that the sheet being copied to has the data put on the next available row (being the next empty row starting at row 1).
copySheetLastRow = copyToWS.Cells(copyToWS.Rows.Count, 1).End(xlUp).Row
This uses the copyToWS worksheet, and gets the last used row. copyToWS.Rows.Count counts the number of rows in the sheet, then looks to the next non-empty row (.End(xlUp)). (This is equivalent at starting at the very last row, in column A, then hitting CTRL+[Up Arrow].
If copySheetLastRow > 1 Then
copySheetLastRow = copySheetLastRow + 1
End If
If the last row is determined to be greater than row 1, then add a row to that, so it becomes # + 1. This is because if the last row is row 1, that means there's no info. in the sheet yet. If, however, the last row is determined to be 4, then that means there is data in row 4. We add 1 to this number, so we don't overwrite the data in that row.
I have the following grid of data:
---------Header 1 Header 2 Header 3 Header 4
Row 1 x x x
Row 2 x x
Row 3 x
Row 4 x x x x
I then have a second sheet that looks like this:
Row 1 Row 2 Row 3 Row 4
I would like the second sheet to end up looking like this:
Row 1 Row 2 Row 3 Row 4
Header 1 Header 2 Header 3 Header 1
Header 3 Header 3 Header 2
Header 4 Header 3
. Header 4
Ignore that last period, I just used it to format it properly.
I've been playing with MATCH and INDEX for a couple hours and while I can get pieces of it, I can't seem to get it to all work together.
EDIT:
I use 'Header 1' and 'Row 1' as examples only. The actual data is text in Column A and Row 1, respectively. Also, since the source data will be modified, I'd prefer to have something that would automatically update the second sheet.
Here is one way to do it with a VBA function:
In the Developer Tab(*) Click on Visual Basic, then click on the "Insert" menu there and choose "Module" to insert a new module. Then paste in the Following code:
Option Explicit
Public Function GetHeaderMatchingRow(RowText As String, _
SearchRange As Range, _
iHdrNo As Integer) As String
Dim rng As Range
Set rng = SearchRange
Dim cel As Range
'Get the Row to scan
Dim i As Long, rowOff As Long
For i = 2 To rng.Rows.Count
Set cel = rng.Cells(i, 1)
If cel.Value = RowText Then
rowOff = i
Exit For
End If
Next i
'Now, scan horizontally for the iHdrNo'th non-blank cell
Dim cnt As Integer
For i = 2 To rng.Columns.Count
Set cel = rng.Cells(rowOff, i)
If Not CStr(cel.Value) = "" Then
cnt = cnt + 1
If cnt = iHdrNo Then
GetHeaderMatchingRow = rng.Cells(1, i).Value
Exit Function
End If
End If
Next i
GetHeaderMatchingRow = ""
End Function
Click on the "Debug" menu and select "Compile VBAProject".
Now go back to Excel and in your first sheet define a Named Range to cover all of your data in the grid. The Row names should be the first column in this range and the Header text should be the first row in it.
Now go to your second sheet and enter a formula like this in every output cell:
=GetHeaderMatchingRow(A$1, RowHeaderRange, 1)
Where the First parameter is the Row text that it will try to match in the first column of the range. I have "A$1" here because the in my test, my second sheet's column headers are also the Row-names in my first sheet, just like yours.
The second argument is the range to search (in this case, the Named Range we defined earlier), and the third argument is the count of the match that it is looking for (1st, 2nd, 3rd, etc.).
Note that the first and third parameters should change based on what column and row the output is for.
Does it have to use worksheet functions? It would be quite a bit simpler to create a macro to do it (I've made an example)
Edited the function to work with row headers in col a and column headers in row 1 and changed it to read from "Source" sheet and write the result to "Output" sheet
Public Sub Example()
Dim Output As Worksheet
Dim Sheet As Worksheet
Dim Row As Integer
Dim Column As Integer
Set Sheet = ThisWorkbook.Worksheets("Source")
Set Output = ThisWorkbook.Worksheets("Output")
Output.Cells.Clear ' Since were going to rebuild the whole thing, just nuke it.
For Row = Sheet.UsedRange.Rows(Sheet.UsedRange.Rows.Count).Row To 2 Step -1
Output.Cells(1, Row - 1).Value = Sheet.Cells(Row, 1).Value
For Column = Sheet.UsedRange.Columns(Sheet.UsedRange.Columns.Count).Column To 1 Step -1
If Not IsEmpty(Sheet.Cells(Row, Column)) Then
Sheet.Cells(1, Column).Copy
Output.Cells(2, Row - 1).Insert xlShiftDown
End If
Next Column
Next Row
End Sub
I had a look at doing it with worksheet functions and as others have said its going to be pretty tricky to do it without some vba mixed in there.
If you add this to a new module then you can access it as a workbook function. (not that this is the best way to do it, just fancied having a go)
'Return The Column Header of the Nth Non-Blank Cell on Specified Row
Public Function NonBlankByIndex(ByVal Row As Integer, ByVal Index As Integer) As Range
Dim Sheet As Worksheet
Dim Column As Integer
Dim Result As Range
Set Sheet = ThisWorkbook.Worksheets("Source") ' Change to your source sheet's name
Set Result = Nothing
Column = 2 ' Skip 1 as its the header
Do
If Column > Sheet.UsedRange.Columns(Sheet.UsedRange.Columns.Count).Column Then
Exit Do
End If
If Sheet.Cells(Row, Column) = "" Then
Column = Column + 1
Else
If Index = 1 Then
Set Result = Sheet.Cells(1, Column)
Exit Do
Else
Column = Column + 1
Index = Index - 1
End If
End If
Loop
Set NonBlankByIndex = Result
End Function
If you are happy with blanks in the listing try this in sheet2!A2:
=IF(INDEX(Sheet1!$B$2:$E$5,MATCH(A$1,Sheet1!$A$2:$A$5,0),ROW()-1)="x",INDEX(Sheet1!$B$1:$E$1,1,ROW()-1),"")
Just copy the formula over range A2:D5