Let's say i have the range of cells A1:C3 and i need to fill in any empty cells from the range with the value that is in cells A4:C4, the emplty cells in column A will be filled with the value of A4, those in column B with the value from B4 and so on.
This is dynamic by both Rows and Columns. The assumption is that the last row is the cell that will be used to fill in blanks. If the assumption is true, you can add rows and columns as you please and this code will work without any modification
Determine last row in range (Determined by Column A)
Determine last column (Determined by last row in step 1)
Loop through rows column by column
Fill blanks with the value associated with the last row if blank
Option Explicit
Sub Test()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") '<== Update Sheet Name
Dim LRow As Long, LCol As Long, r As Long, c As Long
LRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
LCol = ws.Cells(LRow, ws.Columns.Count).End(xlToLeft).Column
Application.ScreenUpdating = False
For c = 1 To LCol
For r = 1 To LRow - 1
If ws.Cells(r, c) = "" Then
ws.Cells(r, c).Value = ws.Cells(LRow, c).Value
End If
Next r
Next c
Application.ScreenUpdating = True
End Sub
Both examples below are from the same macro. Notice that it works as expected for your propsed example (4 Rows x 3 Columns) and for other table sizes like the example on right (8 Rows x 7 Columns)
If all the cells in A1:C3 are empty, then consider:
Sub FillInTheBlanks()
Range("A1:C3").Value = Range("A4:C4").Value
End Sub
If some of the cells in A1:C3 are not empty, then use:
Sub FillInTheBlanks2()
For i = 1 To 3
For j = 1 To 3
If Cells(i, j) = "" Then
Cells(4, j).Copy Cells(i, j)
End If
Next j
Next i
End Sub
You can try this.. just change Worksheets(1) to your desired Worksheet and 4 to desired row
Dim rng As Range
Dim cel As Range
With ThisWorkbook.Worksheets(1)
Set rng = .Range("A1:C3")
For each cel in rng
If Len(Trim(CStr(cel.Value))) = 0 Then cel.Value = .Cells(4, cel.Column).Value
Next
End With
Related
I have a worksheet with data in Column A and Column B, I want to update Column C based on a condition that If
cellB is found in cellA, then cellB is written in Column C on the row of the match from column A.
With the help of the community, I have managed to come up with something but
can someone please tell me why the below loop only works for a few number of rows?
Also, sometimes Column B can be blank, is this a problem? If so, can i skip it if blank?
This works (perhaps its because all the cells have data in them):
Option Explicit
Sub Button2_Click()
Dim cellB As Range
Dim cellA As Range
For Each cellB In Range("b2:b5")
For Each cellA In Range("a2:a5")
If InStr(cellA, cellB) > 0 Then
Range("c" & cellA.Row) = cellB
End If
Next cellA
Next cellB
End Sub
This attempts to update Column C but the cellB values are never updated in the Column C (perhaps its because Column B contain nulls?):
Option Explicit
Sub Button2_Click()
Dim cellB As Range
Dim cellA As Range
For Each cellB In Range("b2:b500")
For Each cellA In Range("a2:a500")
If InStr(cellA, cellB) > 0 Then
Range("c" & cellA.Row) = cellB
End If
Next cellA
Next cellB
End Sub
Snapshot of the worksheet:
Try this way, plase. It will process all existing range, based on the A:A column filled range. It uses an array to collect the processing result and it should be fast enough:
Dim cellB As Range, cellA As Range, sh As Worksheet, lastRow As Long
Dim arrfin As Variant
Set sh = ActiveSheet 'use here your necessary sheet
lastRow = sh.Range("A" & Rows.count).End(xlUp).row
ReDim arrfin(1 To lastRow, 1 To 1)
sh.Range("C:C").Clear
For Each cellA In Range("a2:a" & lastRow)
For Each cellB In Range("b2:b" & lastRow)
If cellA.value <> "" And cellB.value <> "" Then
If InStr(cellA.value, cellB.value) > 0 Then
arrfin(cellA.row, 1) = cellB.value
End If
End If
Next cellB
Next cellA
sh.Range("C1").Resize(UBound(arrfin, 1), UBound(arrfin, 2)).value = arrfin
'For Next' vs 'For Each Next' feat. 'Range' vs 'Cells'
All five examples do the same thing.
They are best copied into a standard module (e.g. Module1) and are then easily run from VBE or called via a Button click event e.g.
Option Explicit
Sub Button2_Click()
updateForEachNextCellsVersion
End Sub
There are two For loops: the For Next loop and the For Each Next loop.
The first two examples use the For Each Next loop, while the remaining two use the For Next loop.
The 1st and 3rd example use Cells, while the 2nd and 4th use Range.
Why would you use Cells when Range is so much easier? You should know both. The biggest downside of Range is that you cannot loop through a row incrementing the columns. For this task only Cells can be used.
The usage of Cells with column numbers is shown in the 5th example.
The Code
Option Explicit
Sub updateForEachNextCellsVersion()
' Calculate the row of the last non-blank cell in column A.
Dim LastRow As Long: LastRow = Cells(Rows.Count, "A").End(xlUp).Row
' Declare the cell ranges for column A and B.
Dim celA As Range, celB As Range
' Loop through rows of column A.
For Each celA In Range(Cells(2, "A"), Cells(LastRow, "A")).Cells
' Loop through rows of column B.
For Each celB In Range(Cells(2, "B"), Cells(LastRow, "B")).Cells
' Check if the current cell in column B is not blank.
If Not IsEmpty(celB) Then
' Check if the values of the current cells in columns A and B
' are equal.
If celA.Value = celB.Value Then
' Write value of current cell in column B to
' column C, to the row of current cell in column A.
Cells(celA.Row, "C").Value = celB.Value
End If
End If
Next celB
Next celA
End Sub
Sub updateForEachNextRangeVersion()
' Calculate the row of the last non-blank cell in column A.
Dim LastRow As Long: LastRow = Range("A" & Rows.Count).End(xlUp).Row
' Declare the cell ranges for column A and B.
Dim celA As Range, celB As Range
' Loop through rows of column A.
For Each celA In Range("A2:A" & LastRow).Cells
' or: For Each celA In Range("A2", "A" & LastRow).Cells
' Loop through rows of column B.
For Each celB In Range("B2:B" & LastRow).Cells
' or: For Each celB In Range("B2", "B" & LastRow).Cells
' Check if the current cell in column B is not blank.
If Not IsEmpty(celB) Then
' Check if the values of the current cells in columns A and B
' are equal.
If celA.Value = celB.Value Then
' Write value of current cell in column B to
' column C, to the row of current cell in column A.
Range("C" & celA.Row).Value = celB.Value
End If
End If
Next celB
Next celA
End Sub
Sub updateForNextCellsVersion()
' Calculate the row of the last non-blank cell in column A.
Dim LastRow As Long: LastRow = Cells(Rows.Count, "A").End(xlUp).Row
' Declare the counters for the loops (i for column A, j for column B).
Dim i As Long, j As Long
' Loop through rows of column A.
For i = 2 To LastRow
' Loop through rows of column B.
For j = 2 To LastRow
' Check if the current cell in column B is not blank.
If Not IsEmpty(Cells(j, "B")) Then
' Check if the values of the current cells in columns A and B
' are equal.
If Cells(i, "A").Value = Cells(j, "B").Value Then
' Write value of current cell in column B to
' column C, to the row of current cell in column A.
Cells(i, "C").Value = Cells(j, "B").Value
End If
End If
Next j
Next i
End Sub
Sub updateForNextRangeVersion()
' Calculate the row of the last non-blank cell in column A.
Dim LastRow As Long: LastRow = Range("A" & Rows.Count).End(xlUp).Row
' Declare the counters for the loops (i for column A, j for column B).
Dim i As Long, j As Long
' Loop through rows of column A.
For i = 2 To LastRow
' Loop through rows of column B.
For j = 2 To LastRow
' Check if the current cell in column B is not blank.
If Not IsEmpty(Range("B" & j)) Then
' Check if the values of the current cells in columns A and B
' are equal.
If Range("A" & i).Value = Range("B" & j).Value Then
' Write value of current cell in column B to
' column C, to the row of current cell in column A.
Range("C" & i).Value = Range("B" & j).Value
End If
End If
Next j
Next i
End Sub
Sub updateForNextCellsColumnNumbersVersion()
' Calculate the row of the last non-blank cell in column A.
Dim LastRow As Long: LastRow = Cells(Rows.Count, 1).End(xlUp).Row
' Declare the counters for the loops (i for column A, j for column B).
Dim i As Long, j As Long
' Loop through rows of column A.
For i = 2 To LastRow
' Loop through rows of column B.
For j = 2 To LastRow
' Check if the current cell in column B is not blank.
If Not IsEmpty(Cells(j, 2)) Then
' Check if the values of the current cells in columns A and B
' are equal.
If Cells(i, 1).Value = Cells(j, 2).Value Then
' Write value of current cell in column B to
' column C, to the row of current cell in column A.
Cells(i, 3).Value = Cells(j, 2).Value
End If
End If
Next j
Next i
End Sub
I have a bunch of non-contiguous data in a table across 108 rows and 15 columns. I'm trying to find the last used cell in every row and paste it to another worksheet.
For example: row 3 last data on column J, row 5 column O...row 38 column I, and so on
I am very new to writing VBA, any help would be great
EDITED
This is what i have:
Sub Selectionoflastcell()
Dim lRow As Long
Dim lCol As Long
Dim ccol As Range
Dim i As Long
With Worksheets("May-July Quarter").ListObjects("Table2").DataBodyRange
Worksheets("Sheet1").Cells(1, 2).ClearContents
lCol = .Cells(1, .Columns.Count).End(xlToRight).Column
Set colrange = .Range(.Cells(1, 1), .Cells(1, lCol))
i = 1
For Each ccol In colrange
lRow = .Cells(.Rows.Count, ccol.Column).End(xlUp).Row
Worksheets("Sheet1").Cells(i, 2).Value = .Cells(lRow, ccol.Column).Value
i = i + 1
Next ccol
End With
End Sub
But it is just giving me the last value of each column from the bottom, if I change it to xltoLeft, I get only the first row
Try this:
Sub Selectionoflastcell()
Dim i As Long, ws As Worksheet, rw As Range
Set ws = Worksheets("May-July Quarter")
i = 1
'loop over the table's rows
For Each rw in ws.ListObjects("Table2").DataBodyRange.Rows
Worksheets("Sheet1").Cells(i, 2).Value = _
ws.Cells(rw.Row, Columns.Count).End(xlToLeft).Value
i = i + 1
Next ccol
End Sub
I'm trying to figure out how to write compare code. I have two sheets', sheet1 and sheet2.
in sheet1 have five digits id numbers in column A, in sheet2 have same five digits id number in column C, but in sheet2 the id number is not the same row as column A in sheet1, they are differents row.
I'm trying to figure out how to make comparisons in sheet1 column A to search for a match in ANY row in sheet2 column B then copy the value from the same row in sheet2 Column C to sheet1 column D!
this is my own testing code but is not working.
Sub FindStuff()
Dim lr As Long
Dim i As Integer
lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To lr
If UCase(Sheet2.Cells(1, 3).Value) = UCase(Sheet1.Cells(i, 1).Value) Then
Sheet2.Cells(14, 5).Value = Sheet1.Cells(i, 1).Offset(, 5).Value
End If
Next i
End Sub
The code you post has both syntax error and logic error, I'm not sure exactly what you are trying to do. Can you post an workbook example?
I changed your formula with Vlookup in the code, you can test and let me know if this is what you need.
Sub MatchValues()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lr As Long
Dim r As Long
Application.ScreenUpdating = False
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
lr = ws2.Cells(Rows.Count, 3).End(xlUp).Row
For r = 2 To lr
On Error Resume Next
Cells(r, 4) = WorksheetFunction.VLookup(ws2.Cells(r, 3).Value, _
ws1.Range("A:A"), 1, 0)
Next
Application.ScreenUpdating = True
End Sub
This is my sheet 1 (source data);
sheet 1 = source (ws1)
I need to "copy" only the rows, where entire rows in the range A7:C1009 are not blank. This selection should then be entered in my sheet 2 (destination) starting from A7 in the table;
sheet 2 = destination (ws2)
I have managed to get this VBA working, but it will include all rows (menaing also the rows, where A:C are all blank/empty;
Private Sub CommandButton1_Click()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim cl1 As Range, rng1 As Range, rng2 As Range, rng3 As Range
Dim r As Long, c As Long
Set ws1 = Worksheets("Indkøb") 'Indkøb
Set ws2 = Worksheets("Kalkulation3") 'Kalkulation3
Set rng1 = ws1.Range("a7:a1009")
Set rng2 = ws1.Range("b7:b1009")
Set rng3 = ws1.Range("c7:c1009")
For Each cl1 In rng1
r = cl1.Row
c = cl1.Column
If cl1.Value <> ws2.Cells(r, c).Value Then
ws2.Cells(r, c).EntireRow.Insert
ws2.Cells(r, c).Value = cl1.Value
End If
Next cl1
For Each cl1 In rng2
r = cl1.Row
c = cl1.Column
If cl1.Value <> ws2.Cells(r, c).Value Then
ws2.Cells(r, c).Value = cl1.Value
End If
Next cl1
For Each cl1 In rng3
r = cl1.Row
c = cl1.Column
If cl1.Value <> ws2.Cells(r, c).Value Then
ws2.Cells(r, c).Value = cl1.Value
End If
Next cl1
End Sub
This is what I want to accomplish;
Only rows where A:C are not empty should be copied from sheet 1 and inserted in the table in sheet 2.
If more rows are added in sheet 1, running the macro again should insert the rows in the table in sheet 2 and move the existing rows - ie. if I insert rows 20 and 21 in sheet 1, row 21 should be copied and inserted as the "new" 8th row in the table in sheet 2, moving all other values/formulas below 8th row 1 down.
Any input on how to get this working would be greatly appreciated. Thank you :-)
This will accomplish what you want for your #1 request. You will need a different macro to accomplish your #2 request. Sorry, I can't help you with that.
Dim lRow As Long
lRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 7 To lRow
If IsEmpty(Cells(i, 1)) And IsEmpty(Cells(i, 2)) And IsEmpty(Cells(i, 3)) Then
Rows(i).EntireRow.Hidden = True
End If
Next i
Dim Rng As Range
Set Rng = ActiveSheet.Cells.SpecialCells(xlCellTypeVisible)
Rng.Copy Destination:=Sheets("Sheet2").Range("A7")
I've seen similar posts, but nothing that has directly addressed my current problem...
I have a workbook with 2 sheets (Sheet1 and Sheet 2). In Sheet1, there are 2 columns - column A contains part numbers from our old ERP system and column B contains weights. In Sheet2, I have 2 columns - column A contains part numbers from our new ERP system and column B contains alias part numbers.
I would like to have a macro read in the part number in Sheet1 (which sits in column A) and see if that value exists in Sheet2 in either column A or column B. If it finds a match, it would need to copy the corresponding weight to column C on Sheet2.
I am a novice at writing macros and I've attached a modified version of code posted to a similar problem. Any help would be greatly appreciated - thank you in advance to any replies.
Sub CopyCells()
Application.ScreenUpdating = False
Dim sh1 As Worksheet, sh2 As Worksheet
Dim j As Long, i As Long, lastrow1 As Long, lastrow2 As Long
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
lastrow1 = sh1.Cells(Rows.Count, "A").End(xlUp).Row
lastrow2 = sh2.Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To lastrow1
For j = 2 To lastrow2
If sh1.Cells(i, "A").Value = sh2.Cells(j, "A").Value Or _
sh1.Cells(i, "A").Value = sh2.Cells(j, "B").Value Then
sh1.Cells(i, "B").Value = sh2.Cells(j, "C").Value
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub
This might help get you started. I am assuming you have data starting in row 1 in columns A and B of Sheet1 and Sheet2 and that you want to copy weights to Column C in Sheet2 :
Sub GetMatches()
Dim PartRngSheet1 As Range, PartRngSheet2 As Range
Dim lastRowSheet1 As Long, lastRowSheet2 As Long
Dim cl As Range, rng As Range
lastRowSheet1 = Worksheets("Sheet1").Range("A65536").End(xlUp).Row
Set PartRngSheet1 = Worksheets("Sheet1").Range("A1:A" & lastRowSheet1)
lastRowSheet2 = Worksheets("Sheet2").Range("B65536").End(xlUp).Row
Set PartRngSheet2 = Worksheets("Sheet2").Range("A1:A" & lastRowSheet2)
For Each cl In PartRngSheet1
For Each rng In PartRngSheet2
If (cl = rng) Or (cl = rng.Offset(0, 1)) Then
rng.Offset(0, 2) = cl.Offset(0, 1)
End If
Next rng
Next cl
End Sub