I'm in dire need for code that will copy & paste newly extracted data into a tracking worksheet, based off of matching numbers in the first column.
I have two worksheets, "Registry" and "Sheet2". Registry is used for tracking, Sheet2 has new data I want to transfer into Registry.
I want the insurance type data (col B) from Sheet2 to be copied and pasted into the insurance type column in Registry (col E). But I need it to match up with the ID's in col A because my extraction doesn't include all ID's that I have listed in Registry.
If helpful, the range of cells w/ data in Registry is row2:row177; range of cells w/ data in Sheet2 is row2:row174
I appreciate all the help, let me know if I wasn't clear enough or if you need any more info.
Thanks,
Kyle
Sub updateins()
Dim i As Long
Dim j As Long
Sheet1LastRow = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
Sheet2LastRow = Worksheets("Registry").Range("A" & Rows.Count).End(xlUp).Row
For j = 2 To Sheet1LastRow
For i = 2 To Sheet2LastRow
If Worksheets("Sheet2").Cells(j, 1).Value = Worksheets("Registry").Cells(i, 1).Value Then
Worksheets("Sheet2").Cells(j, 2).Value = Worksheets("Registry").Cells(i, 5).Value
Else
End If
Next i
Next j
End Sub
Not sure what the problem might be. The code is working fine for me. Here are just a few minor adjustments as proposed:
Option Explicit
Sub updateins()
Dim i As Long
Dim j As Long
Dim Sheet1LastRow As Long
Dim Sheet2LastRow As Long
Sheet1LastRow = Worksheets("Sheet2").Range("A" & Worksheets("Sheet2").Rows.Count).End(xlUp).Row
Sheet2LastRow = Worksheets("Registry").Range("A" & Worksheets("Registry").Rows.Count).End(xlUp).Row
MsgBox "Comparing rows 2 through " & Sheet1LastRow & " on 'Sheet2'" & Chr(10) & _
"with rows 2 through " & Sheet2LastRow & " on 'Registry'."
For j = 2 To Sheet1LastRow
For i = 2 To Sheet2LastRow
If UCase(Trim(Worksheets("Sheet2").Cells(j, 1).Value)) = UCase(Trim(Worksheets("Registry").Cells(i, 1).Value)) Then
Worksheets("Registry").Cells(j, 5).Value = Worksheets("Sheet2").Cells(i, 2).Value
End If
Next i
Next j
End Sub
I merely added a MessageBox to make sure that both last rows are correctly determined through column A.
Related
I created a code to select and paste data from one sheet to another. But this code is always selecting last three values in row.
I need to select the data based on given range. Eg C5:C15 not for the entire c column. Help me
Private Sub CommandButton1_Click()
Dim LastRow1, LastRow2, LastRow3 As Long
Dim Last3Rows1, Last3Rows2, Last3Rows3 As Range
LastRow3 = Sheets("AVG-PO").Range("C" & Rows.Count).End(xlUp).Row
LastRow1 = Sheets("AVG-PO").Range("A" & LastRow3).End(xlUp).Row
LastRow2 = Sheets("AVG-PO").Range("B" & LastRow3).End(xlUp).Row
Set Last3Rows3 = Sheets("AVG-PO").Range("C" & LastRow3).Offset(-2, 0).Resize(3, 1)
Set Last3Rows1 = Sheets("AVG-PO").Range("A" & LastRow3).Offset(-2, 0).Resize(3, 1)
Set Last3Rows2 = Sheets("AVG-PO").Range("B" & LastRow3).Offset(-2, 0).Resize(3, 1)
Last3Rows1.Select
Selection.Copy Sheets("Data").Range("A30")
Last3Rows2.Select
Selection.Copy Sheets("Data").Range("B30")
Last3Rows3.Select
Selection.Copy Sheets("Data").Range("C30")
End Sub
Not sure i quite understand what range you want but you might be able to use this.
Sub test()
Dim NextFree As Long
Dim TableStartRange As Long
For i = 1 To 100
Select Case Range("A" & i).Value
Case "Table1"
TableStartRange = i + 1 'finds table1 in A2 and then +1 before the actual table start in column C
End Select
NextFree = Range("C" & TableStartRange & ":C" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row ' returns the value 14 since its the first free row in column C
End Sub
Hi I'm a bit new to vba so I will try to explain my problem as far as possible.
I have a dataset in Excel in Column A, I have a lot of file names like this:
1. AB000**1234**45.tif
2. AB000**1235**45.tif
3. AB000**1236**45.tif
4. AB000**1237**45.tif
etc..
From this I want to take out all the strong characters and put in column C so it will look like this:
1. 1234
2. 1235
3. 1236
4. 1237
etc..
At the moment I have a code that looks like this:
Sub TakeOut
Dim str1 As String
Dim LR As Long
Dim cell As Range, RNG As Range
LR = Range("A" & Rows.Count).End(xlUp).Row
Set RNG = Range("A1:A" & LR)
For Each cell In RNG
L = Len(RNG)
If L > 0 Then
RNG = ...
End If
Next cell
Range("C:C").Columns.AutoFit
End Sub
I have tried to count left(5) and right(6) but don't know how to take out the 4 character that I want.
Hope you can help me with this.
If you want to take out the strong characters from the string. Try it below. It will take all the Bold Characters in a cell and place it in C column.
Hope you are looking for this?
Sub get_bold_content()
Dim lastrow, i, j, totlength As Long
lastrow = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To lastrow
totlength = Len(Range("A" & i).Value)
For j = 1 To totlength
If Range("A" & i).Characters(j, 1).Font.Bold = True Then
outtext = outtext & Range("A" & i).Characters(j, 1).Text
End If
Next j
Range("C" & i).Value = outtext
outtext = ""
Next i
End Sub
Take a look at the Mid() Function link.
usage in your case:
Mid(cell.Value, 6, 4) 'First parameter is the string, 6 is the start character, 4 is length
The easiest way without looping would be something like this:
Sub TakeOut()
Dim rng As Range
Set rng = Range("A1", Range("A" & Rows.Count).End(xlUp))
rng.Offset(, 1) = Evaluate("IF(" & rng.Address & "="""","""",MID(" & rng.Address & ",6,4))")
End Sub
I have this problem I'd like to compare two columns in one worksheet to another two columns in other worksheet and then if it's true fill other column with data.
I wrote some code but it worked only till 47 row. don't know the problem. Excel is not responding. Here's my code. Maybe someone can shed some light on what I did wrong
Sub Compare()
Dim i, j As Integer
For i = 2 To 2175
For j = 2 To 3834
If (ActiveWorkbook.Worksheets("Arkusz2").Range("B" & i) = ActiveWorkbook.Worksheets("Arkusz3").Range("A" & j) _
And ActiveWorkbook.Worksheets("Arkusz2").Range("C" & i) = ActiveWorkbook.Worksheets("Arkusz3").Range("B" & j)) _
Then ActiveWorkbook.Worksheets("Arkusz2").Range("E" & i).Value = ActiveWorkbook.Worksheets("Arkusz3").Range("C" & j).Value
Next j
Next i
End Sub
Try this. I added comments on the lines below where I made changes.
Sub Compare()
Dim i as Integer, j As Integer
' You need to specify the value type for *all* variables
Dim ws1 as Worksheet, ws2 as Worksheet
Set ws1 = ActiveWorkbook.Worksheets("Arkusz2")
Set ws2 = ActiveWorkbook.Worksheets("Arkusz3")
' Setting these as their own variables makes the code far more readable
For i = 2 To 2175
For j = 2 To 3834
If (ws1.Range("B" & i).Value = ws2.Range("A" & j).Value _
And ws1.Range("C" & i).Value = ws2.Range("B" & j).Value) Then
' Make sure you are comparing the VALUES and not the range objects
ws1.Range("E" & i).Value = ws2.Range("C" & j).Value
Exit For
' If we've found a match, exit the inner loop early (if it *would* find
' another match, the orig. value would just be overwritten, anyways)
' This will likely reduce the time to complete significantly
End If
Next j
Next i
End Sub
Edit: Added the Exit For to quit the inner loop early after a match has been found. Credit to #Tim Williams for the suggestion.
Newbee here to both this site and Excel VBA. I used RichA's code in the below post and was able to make it work well for my purpose of populating/copying data in on sheet (Sheet2) from another sheet.
CODE LINK TO ORIGINAL POST
Excel VBA Copy and Paste Loop within Loop
I have a question on how to limit the range to a 'named range' (C13:Z111) rather than the 'entire column' ("C") in this code. I cannot seem to get it to limit to copy rows, starting with last row with data and counting down to the first row.
I have some rows (C1:C12) with titles at the top and the data starts at row 13. So when copying values from one sheet to the 'other' sheet, the top rows also copy. I would like to end the copying of data at row 13.
Thank you for your help.
Here is what currently works with the exception that I am not able to limit the range.
Sub Generate_Invoice()
Dim i As Long
Dim ii As Long
Dim i3 As Long
Dim LastRow As Long
Dim wb As Workbook
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Set wb = ThisWorkbook
Set sht1 = wb.Sheets("INCENTIVE")
Set sht2 = wb.Sheets("Sheet2")
Sheets("Sheet2").Select
Range("B11:Z200").ClearContents
'Find the last row (in column C) with data.
LastRow = sht1.Range("C13:C111").Find("*", searchdirection:=xlPrevious).Row
ii = 2
'This is the beginning of the loop >>>This Works BUT BUT BUT goes all the way to the top - REQUESTING HELP WITH CODE ENDS AT ROW 13 AND DOES NOT GO PAST<<<
For i = 3 To LastRow
'First activity
sht2.Range("B" & ii) = sht1.Range("C" & i).Value
sht2.Range("C" & ii) = sht1.Range("G" & i).Value
sht2.Range("D" & ii) = sht1.Range("H" & i).Value
sht2.Range("E" & ii) = sht1.Range("P" & i).Value
sht2.Range("F" & ii) = sht1.Range("R" & i).Value
sht2.Range("G" & ii) = sht1.Range("AD" & i).Value
ii = ii + 1
Next i
'Return to "Sheet2"
Sheets("Sheet2").Select
'Add SUM at bottom of last record in Range"D"
Dim ws As Worksheet
For Each ws In Worksheets
With ws.Range("F" & Rows.Count).End(xlUp).Offset(2)
.FormulaR1C1 = "=SUM(R11C6:R[-1]C6)"
.Offset(, -1).Value = "Total:"
End With
Next ws
End Sub
You were looking for the last row but only looking within the populated area. I would suggest changing the method that the last row is determined by starting at the bottom of the worksheet and finding the last populated cell in column C. This would be like being in C1048576 and tapping Ctrl+▲.
'Find the last row (in column C) with data.
LastRow = sht1.Cells(Rows.Count, "C").End(xlUp).Row
'not sure whether you want to reverse this as well
ii = 2
'This is the beginning of the loop >>>This Works BUT BUT BUT goes all the way to the top - REQUESTING HELP WITH CODE ENDS AT ROW 13 AND DOES NOT GO PAST<<<
For i = LastRow To 13 Step -1 'work from the bottom to the top.
'First activity
sht2.Range("B" & ii) = sht1.Range("C" & i).Value
sht2.Range("C" & ii) = sht1.Range("G" & i).Value
sht2.Range("D" & ii) = sht1.Range("H" & i).Value
sht2.Range("E" & ii) = sht1.Range("P" & i).Value
sht2.Range("F" & ii) = sht1.Range("R" & i).Value
sht2.Range("G" & ii) = sht1.Range("AD" & i).Value
'not sure whether you want to reverse this as well
ii = ii + 1
Next i
You just need to exit the for loop based on whatever your desired criteria is. For example:
If ii = 13 Then Exit For
I need to protect some data using VBA in a worksheet but leave some cells open so that data can be entered - tab name "Part Order"
My data starts in A5 and goes through to J
I have a couple of issues which I am struggling to resolve - see below
If data is found in column A from cell 5 then lock (A to F) then (H) And Then all cells from (K) to the end of the worksheet
this leaves all cells unlocked in G5 down I5 down and J down
If data is not found in column A from cell 5 then lock the complete row
If anyone can help with this it would be most appreciated.
Thanks in advance
Try this one:
Sub LockCells()
Dim sLastColName As String
Dim lLastRow As Long
Dim i As Long
With Worksheets("Part Order")
sLastColName = Mid(.Cells(1, .Columns.Count).Address, 2, _
InStr(2, .Cells(1, .Columns.Count).Address, "$") - 2)
lLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Cells.Locked = False
For i = 5 To lLastRow
If .Cells(i, "A").Value <> vbNullString Then
.Range("A" & i & ":F" & i & ",H" & i & ",K" & i & ":" & sLastColName & i).Locked = True
Else
.Rows(i).Locked = True
End If
Next i
End With
End Sub