I tried to link the common columns together but when I click a cell in PolicyComponents Sheet, the for loop doesn't run - it just exits the sub.
Code Snippet:
Sub LinkName()
Dim i As Long
Dim ShtUsedRange, ShtUsedRangeCol
Dim name As String
Dim name1 As String
Dim lookup_range As Range
Dim box
ShtUsedRange = ActiveSheet.UsedRange.Rows.Count
'Count the used rows in the Activesheet
ShtUsedRangeCol = ActiveSheet.UsedRange.Columns.Count
'Count the used Column in the Activesheet
name = ActiveCell.Row
'Row of the Selected Cell
name1 = ActiveSheet.Cells(name, 1).Value
'name of the row selected
'MsgBox name1
Set lookup_range = ThisWorkbook.Sheets("PolicyDetails").Range("a1:z5000")
'set the range of the Policy details to search from
box = Application.WorksheetFunction.VLookup(name1, lookup_range, 1, False)
'to match the name to the policy details
MsgBox box
For i = 1 To ThisWorkbook.Sheets("PolicyComponents").Rows.Count Step -1
If ThisWorkbook.Sheets("PolicyComponents").Cells(i, 1).Value = box Then
ThisWorkbook.Sheets("Policy Viewer").Cells(16, 2).Value = ThisWorkbook.Sheets("PolicyComponents").Cells(i, 4).Value
End If
Next i
End Sub
You are using name as a string type variable but assigning it the row number value. This means that name is "2" and not 2 and cannot be used when a number is required. It is also never a good idea to call your variables the same as reserved words like VBA's .Name.
You are using Step -1 but starting at 1 which means it will never go anywhere.
That should be enough to get the loop going.
Sub LinkName()
Dim i As Long
Dim ShtUsedRange, ShtUsedRangeCol
Dim rw As Long
Dim lu As Variant
Dim lookup_range As Range
Dim box As Variant
'Count the used rows in the Activesheet
ShtUsedRange = ActiveSheet.UsedRange.Rows.Count
'Count the used Column in the Activesheet
ShtUsedRangeCol = ActiveSheet.UsedRange.Columns.Count
'Row of the Selected Cell
rw = ActiveCell.Row
'name of the row selected
lu = ActiveSheet.Cells(rw, 1).Value
'MsgBox lu
'set the range of the Policy details to search from
Set lookup_range = ThisWorkbook.Sheets("PolicyDetails").Range("a1:z5000")
'there is no error control here if there is no match
'to match the name to the policy details
box = Application.WorksheetFunction.VLookup(lu, lookup_range, 1, False)
MsgBox box
For i = 1 To ThisWorkbook.Sheets("PolicyComponents").Rows.Count Step 1
If ThisWorkbook.Sheets("PolicyComponents").Cells(i, 1).Value = box Then
ThisWorkbook.Sheets("Policy Viewer").Cells(16, 2) = _
ThisWorkbook.Sheets("PolicyComponents").Cells(i, 4).Value
'probably best to exit hte loop here unless you want to try and catch other matches
'Exit For
End If
Next i
End Sub
I renamed two of your variables. I didn't know the nature of the value (number/text/date) you were actually trying to look up so I left it as a variant.
You loop is going from 1 to the row count, but using i with a step of -1 which means you are counting backwards, never getting to ...Rows.Count.
Change the order of your loop, going from Rows.Count to 1 if you want to use a step like that or use Step 1 to count up by one (the default).
Related
I want to write macro which sets cells in worksheets "Section_errors" and "Elemant_errors" is equal to cells in "ICS Analysis" worksheet. All data exists in "ICS Analysis" . I try the code below, but it doesnot work and any error doesnot appear. What can be a reason? I tryied also simple copy-paste, it operates, but it takes too much time
Sub copy_id()
Dim i As Integer
Dim lastrow As Integer
lastrow = Worksheets("ICS Analysis").Cells(Worksheets("ICS Analysis").Rows.Count, 1).End(xlUp).Row
For i = 1 To lastrow
Worksheets("Element_errors").Cells(i, 73).Value = Worksheets("ICS Analysis").Cells(i, 3).Value
Worksheets("Section_errors").Cells(i, 10).Value = Worksheets("ICS Analysis").Cells(i, 3).Value
Next i
End Sub
The solution according to me is:
Sub copy_id()
Dim i As Integer
Dim lastrow As Integer
lastrow = Worksheets("ICS Analysis").Cells(Worksheets("ICS Analysis").Rows.Count,1).End(xlUp).Row
For i = 1 To lastrow
Worksheets("Element_errors").Cells(i, 73).Value = Worksheets("ICS Analysis").Cells(i,3).Value
Worksheets("Section_errors").Cells(i, 10).Value = Worksheets("ICS Analysis").Cells(i,3).Value
Next i
End Sub
The change is the location of the definition of the variable lastrow.
You see, in the earlier version, the lastrow was getting a value 1 before entering the loop and thus the loop was not running.
Hence no data.
Hope this helps...
I am trying to creat a form in excel using VBA, but I am stuck at the Code. I need to find out the code to enter a data to my worksheet using VBA form . here is the code I am using, but doesn't work..
Private Sub cmdAdd_Click()
Dim LastRow As Range
Dim DPDIAdhocRequestTable As ListObject
With LastRow
Cells(1, 2) = RequesterName.Value
Cells(1, 3) = RequesterPhoneNumber.Value
Cells(1, 4) = RequesterBureau.Value
Cells(1, 5) = DateRequestMade.Value
Cells(1, 6) = DateRequestDue.Value
Cells(1, 7) = PurposeofRequest.Value
Cells(1, 8) = ExpectedDataSaurce.Value
Cells(1, 9) = Timeperiodofdatarequested.Value
Cells(1, 10) = ReoccuringRequest.Value
Cells(1, 11) = RequestNumber.Value
Cells(1, 12) = AnalystAssigned.Value
Cells(1, 13) = AnalystEstimatedDueDate.Value
Cells(1, 14) = AnalystCompletedDate.Value
Cells(1, 15) = SupervisiorName.Value
End With
End Sub
can you help me to figure out the correct code for enter command?
thank you so much for your help.
As #Adam said - you've created LastRow and not assigned it to anything.
I'm guessing it's the next row you want to paste your data into, so it should be a Long holding the row number rather than an actual reference to the cell.
In the code below you could qualify the form controls by adding Me., for example Me.RequesterName.Value
https://msdn.microsoft.com/en-us/library/office/gg251792.aspx
Private Sub cmdAdd_Click()
Dim wrkSht As Worksheet
Dim LastRow As Long
'The sheet you want the data to go into.
Set wrkSht = ThisWorkbook.Worksheets("Sheet1")
'You're after the last row number, rather than referencing the range so LastRow is a Long.
'This looks for the last cell containing data in column A (the 1 in 'Cells(...)').
LastRow = wrkSht.Cells(Rows.Count, 1).End(xlUp).Row + 1
'With... End With block. Cells is preceded by a '.' notation - indicating it's referencing the 'With wkrSht'#
'https://msdn.microsoft.com/en-us/library/wc500chb.aspx
With wrkSht
'Using LastRow as row number in cell reference.
.Cells(LastRow, 2) = RequesterName.Value
'Before adding dates to the sheet you might want to check that the
'user entered a date and not rubbish.
.Cells(LastRow, 5) = DateRequestMade.Value
'You could use CDATE to force it to a date - will try and coerce the entered text into a date.
'Note - 1 will be changed to 01/01/1900 (so will need to add extra code to check it really is a date).
.Cells(LastRow, 5) = CDate(DateRequestMade.Value)
End With
End Sub
The first problem is that you've created a Range named LastRow but haven't assigned anything to it.
'Declaration
Dim LastRow As Range
'Assigns the last row based on the last item in Column A
Set LastRow = Range("A" & Rows.Count).End(xlUp).Row
With LastRow
...
End With
The second issue is a minor syntax error in your With LastRow block.
With LastRow
Cells(x,y).Value = "Foo"
End With
Should be
With LastRow
.Cells(x,y).Value = "Foo"
End With
Which is essentially the same as saying LastRow.Cells(x,y).Value = "Foo". Without the "." in front of Cells() VBA will not apply the With to that object, and assume you meant ActiveSheet.Cells()
I've been working on a Macro that i need to copy, concatenate what has been selected through the counter. e.g. is below
excel snapshot example
so what i want to do is set a count in column c from 1 to "infinite" because each worksheet varies to go up to 10 or hundreds and when the counter hits a value of 1 again to stop concatenate column D what is in the range from 1 to "the last digit it stopped before hitting 1 again" and paste it on a different sheet. I know little to nothing on VBA but I understand the copy and paste to different sheet part. I'm just stuck on the counter and the concatenate part. Here is the code i have so far(i edited it to resemble the example for better reference)
'select counter/concatenate
Sheets(1).Select
Columns("C").EntireColumn
Do
Columns("C").Count
For i = 1 To 9999
Loop While (i <= 1)
If i = 1 Then
select.columns("D")
after the count is where i am stuck. this count is what I've come up with looking at different variations of counters.
I suggest you Forget about column and use just one cell for easier understanding. A cell is a reference that allows you to refer to any other cells on the sheet by using Offsets. You may use two Loops, the outer one crawling the columns, the inner one working downward until it finds 1
Dim i As Long ' note that in VBA integer Overflows at 65535 rows
Dim s As String
Set aCell = Worksheet("Sheet1").Range("D1")
While aCell.Column < 255
i = 0
s = ""
While Not aCell.Offset(i, 0).Value = 1
s = s & aCell.Offset(1, 0).Value
Wend
' paste s somewhere by using range.value = s
Set aCell = aCell.Offset(0, 1)
Wend
By specifying the workbook and worksheet before the range, you may refer to the proper cell without being dependent on the active worksheet or range.
Hope this works for you.
You can try this (not tested):
Dim s As String, firstAddr as String
Dim f as range, iniCell As Range
With Worksheet("MySheet") '<--| change "MySheet" to your actual sheet name
With .Range("C1", .Cells(.Rows.Count, 3).End(xlUp))
Set f = .Find(What:=1, LookAt:=xlWhole, LookIn:=xlValues, After:=.Cells(.Rows.Count, 1))
If Not f Is Nothing Then
firstAddr = f.Address
Set iniCell = f
Set f = FindNext(f)
Do While f.Address <> firstAddr
s = s & Join(Range(iniCell, f.Offset(-1)).Offset(, 1), "")
' here code to paste s somewhere
Set iniCell = f
Set f = FindNext(f)
Loop
End If
End With
End With
Here's one I actually tested, using some random data in columns C and D.
You'll have to modify a little to get exactly where you want the data to go, but should get you in the right direction.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long
Dim s As String
Dim lastRow As Long
Dim c As Integer
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("Sheet2")
lastRow = ws1.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
'This will get an accurate last row
c = 1
For i = 1 To lastRow
s = s & ws1.Cells(i, 4).Value 'Build the string
If ws1.Cells(i + 1, 3).Value = 1 Or ws1.Cells(i + 1, 3).Value = "" Then
ws2.Cells(c, 1).Value = s
s = ""
c = c + 1
'If the next cell to check is 1 or blank, then copy the values to the next cell in order on sheet2
End If
Next
End Sub
Walking through it, lastRow is set using the last row in the sheet with a value in it. Then, c is set to one, although you could set this to the last available row in ws2 using the same process. After that it just steps through the rows from 1 To LastRow building strings and transferring the value to ws2 when it's about to hit a 1.
I am trying to build a macro that loops through a range of values within colA and check if they exist with another workbook. In one of them I would like to mark it "Worked"/"Not Worked"
Any guidance on where to start?
Example
Here is an example of what you're looking for. Remember that both the workbooks have to be opened in the same instance of Excel.
Sub check()
Dim i As Integer, k As Integer, j As Integer 'Define your counting variables
Dim Report1 As Worksheet, bReport As Workbook, Report2 As Worksheet, bReport2 As Workbook 'Define your workbook/worksheet variables
Set Report1 = Excel.ActiveSheet 'Assign active worksheet to report1
Set bReport = Report1.Parent 'Assign the workbook of report 1 to breport
On Error GoTo wbNotOpen 'If an error occurs while accessing the named workbook, send to the "wbNotOpen" line.
Set bReport2 = Excel.Workbooks("otherworkbookname.xlsm") 'Assign the other workbook which you are cross-referencing to the bReport2 variable.
Set Report2 = bReport2.Worksheets("otherworksheetname") 'Do the same with the worksheet.
On Error GoTo 0 'Reset the error handler (to undo the wbNotOpen line.)
k = Report1.UsedRange.Rows.Count 'Get the last used row of the first worksheet.
j = Report2.UsedRange.Rows.Count 'Get the last used row of the second worksheet.
For i = 2 To k 'Loop through the used rows of the first worksheet. I started at "2" to omit the header.
'Next, I used the worksheet function "countIf" to quickly check if the value exists in the given range. This way we don't have to loop through the second worksheet each time.
If Application.WorksheetFunction.CountIf(Report2.Range(Report2.Cells(2, 1), Report2.Cells(j, 1)), Report1.Cells(i, 1).Value) > 0 Then
Report1.Cells(i, 5).Value = "Worked" 'If the value was found, enter "Worked" into column 5.
Else
Report1.Cells(i, 5).Value = "Not worked" 'If the value wasn't found, enter "Not worked" into column 5.
End If
Next i
Exit Sub
'This is triggered in the event of an error while access the "other workbook".
wbNotOpen:
MsgBox ("Workbook not open. Please open all workbooks then try again.")
Exit Sub
End Sub
This link also includes steps that tell how to check if a cell exists in another workbook. The comments are useful.
Excel macro - paste only non empty cells from one sheet to another (Stack Overflow)
Thanks to #Lopsided's solution, I have tweeked his code to bring forth this solution. And this seems to work.
{
Sub CheckValue()
Dim S1 As Worksheet
Dim S2 As Worksheet
Dim i As Integer
Dim k As Integer
Dim j As Integer
Set S1 = Worksheets("Sheet1")
Set S2 = Worksheets("Sheet2")
k = S1.UsedRange.Rows.Count
j = S2.UsedRange.Rows.Count
For i = 1 To k
If Application.WorksheetFunction.CountIf(S2.Range(S2.Cells(2, 1), S2.Cells(j, 1)), S1.Cells(i, 1).Value) > 0 Then
S1.Cells(i, 5).Value = "Worked" 'If the value was found, enter "Worked" into column 5.
Else
S1.Cells(i, 5).Value = "Not worked" 'If the value wasn't found, enter "Not worked" into column 5.
End If
Next i
End Sub
}
I have a spreadsheet that list a Case Manager and then list the students below it. Then it lists another Case Manager and students below it. I want to copy the Case Manager Name from the top of each list to the end of the row of respective students underneath, repeating with each Case Manager until I get to the end of my sheet. The number of Case Managers and students can vary.
I have the following code to do the first Case Manager but not sure how to loop it of if there is a better solution. I want all the data to stay in the original spot.
Original Source: (Imported Text File)
Modified Source: (After Macro is Run)
Sub CMWizard()
Dim CMName As String
Dim StopRow As Long
Dim r As Long
CMName = Range("A1").Value 'Get the Case Manager Name.
StopRow = Range("B2").End(xlDown).Row 'Get first blank cell in Column B.
For r = 2 To StopRow 'Start at Row 2 and continue until you reach the StopRow.
Cells(r, 6).Value = CMName 'Set every cell from Row 2 in Column F (6) to the Case Manager Name.
End Sub
Let's say your Excel file looks like this
Paste this code in a module. I have commented the code so that you will not have a problem understanding it.
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim i As Long, LRow As Long, R As Long
Dim CM As String
Dim delRng As Range
Application.ScreenUpdating = False
'~~> Replace Sheet 1 with the relevant sheet name
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
'~~> Get last row of Col A
LRow = .Range("A" & .Rows.Count).End(xlUp).Row
'~~> Loop through cells in Col A
For i = 1 To LRow
'~~> Check if the cell contains "Case Manager"
If InStr(1, .Cells(i, 1).Value, "Case Manager", vbTextCompare) Then
'~~> Store the Case manager's name in a variable
CM = .Cells(i, 1).Value
'~~> Store the row numbers which have "Case Manager"
'~~> We will delete it later
If delRng Is Nothing Then
Set delRng = .Rows(i)
Else
Set delRng = Union(delRng, .Rows(i))
End If
Else
'~~> Store the Case manager in Col F
.Cells(i, 6).Value = CM
End If
Next i
End With
'~~> Delete the rows which have "Case Manager"
If Not delRng Is Nothing Then delRng.Delete
Application.ScreenUpdating = True
End Sub
Output
i think you are just missing an next
Sub CMWizard()
Dim CMName As String
Dim StopRow As Long
Dim r As Long
CMName = Range("A1").Value 'Get the Case Manager Name.
StopRow = Range("B2").End(xlDown).Row 'Get first blank cell in Column B.
For r = 2 To StopRow 'Start at Row 2 and continue until you reach the StopRow.
Cells(r, 6).Value = CMName 'Set every cell from Row 2 in Column F (6) to the Case Manager Name.
Next
End Sub
just be aware that StopRow = Range("B2").End(xlDown).Row will return last row in worksheet if there are just empty cells below ("B2")
Hope it helps