I want to be able to add multiple data in 2 sheets. With that I have an error:
Run Time Error '91' : Object Variable or With Block not Set
Referring to this line:
With Sheetclient = ThisWorkbook.Sheets(CMB_Test.Value)
The first page is chosen by a combobox value and it's working well, and the second page will automatically something the page: "testbit".
Private Sub Save_test_Click()
Dim Sheetclient As Worksheet
Dim testbit1 As Worksheet
Dim nr As Integer, lr As Integer
With Sheetclient = ThisWorkbook.Sheets(CMB_Test.Value)
nr = Sheetclient.Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheetclient.Cells(nr, 5) = Me.TB_dateBit.Value
Sheetclient.Cells(nr, 6) = Me.serial.Value
Sheetclient.Cells(nr, 7) = Me.matrice.Value
Sheetclient.Cells(nr, 8) = Me.CMB_config.Value
Sheetclient.Cells(nr, 9) = Me.lifetime.Value
End With
With testbit1 = ThisWorkbook.Sheets("testbit")
nr = testbit1.Cells(Rows.Count, 1).End(xlUp).Row + 1
testbit1.Cells(nr, 1) = Me.TB_dateBit.Value
testbit1.Cells(nr, 2) = Me.serial.Value
testbit1.Cells(nr, 3) = Me.matrice.Value
testbit1.Cells(nr, 4) = Me.CMB_config.Value
testbit1.Cells(nr, 5) = Me.lifetime.Value
End with
End
End Sub
You need to Set the object - and having Set it, you can use . to reference it. Thus your code might look like this:
Set Sheetclient = ThisWorkbook.Sheets(CMB_Test.Value)
With Sheetclient
nr = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(nr, 5) = Me.TB_dateBit.Value
.Cells(nr, 6) = Me.serial.Value
.Cells(nr, 7) = Me.matrice.Value
.Cells(nr, 8) = Me.CMB_config.Value
.Cells(nr, 9) = Me.lifetime.Value
End With
Same for the second part of the code
Related
I am attempting to draw data from a separate sheet and put it into a corresponding cell if the conditions are met. My code works, but it is not efficient. I do not know how to change the For Next loop so that it attempts to draw data only until the final entry. Right now I have it set to go a hundred or so cells further than I need so that I wouldn't have to update the code as often when I input new data to the data sheet (or at least that was the thought). Here is my code:
Sub LRearTest()
Dim R As Integer
Dim j As Integer
For j = 89 To 250
For R = 1 To 300
If Worksheets("Input").Cells(j, 22).Value >= Worksheets("1036L").Cells(R, 5).Value And Worksheets("Input").Cells(j, 22).Value <= Worksheets("1036L").Cells(R, 6).Value Then
Worksheets("Input").Cells(j, 20).Value = Worksheets("1036L").Cells(R, 3).Value
End If
Next R
Next j
End Sub
The problem is when I run this code it takes almost two minutes before it is over. I am not sure if it is because I have used j and r as integers or what. Also I have a dozen of these on one module so I am not sure if that contributes. The code works like I said, it is just far too slow. Help is greatly appreciated.
The point that I am checking is in Column V of Sheet "Input". Each of my columns that I want to populate, F - U, use the same data in column V. The sheets that I am comparing the data in column V against are labeled as 1030L, 1030R, 1031L, 1031R, 1032L, 1032R, 1033L, 1033R, 1034L, 1034R, 1034LA, 1034RA, 1035L, 1035R, 1036L, and 1036R. The data being compared is in the same columns in every sheet. Thank you
Something like this should work for you:
Sub LRearTest()
Dim wb As Workbook
Dim wsInput As Worksheet
Dim wsData As Worksheet
Dim aDataParams() As String
Dim aInput As Variant
Dim aData As Variant
Dim InputIndex As Long
Dim DataIndex As Long
Dim ParamIndex As Long
Dim MinCol As Long
Set wb = ActiveWorkbook
Set wsInput = wb.Sheets("Input")
'Adjust the column associations for each sheet as necessary
ReDim aDataParams(1 To 16, 1 To 3)
aDataParams(1, 1) = "1030L": aDataParams(1, 2) = "F"
aDataParams(2, 1) = "1030R": aDataParams(2, 2) = "G"
aDataParams(3, 1) = "1031L": aDataParams(3, 2) = "H"
aDataParams(4, 1) = "1031R": aDataParams(4, 2) = "I"
aDataParams(5, 1) = "1032L": aDataParams(5, 2) = "J"
aDataParams(6, 1) = "1032R": aDataParams(6, 2) = "K"
aDataParams(7, 1) = "1033L": aDataParams(7, 2) = "L"
aDataParams(8, 1) = "1033R": aDataParams(8, 2) = "M"
aDataParams(9, 1) = "1034L": aDataParams(9, 2) = "N"
aDataParams(10, 1) = "1034R": aDataParams(10, 2) = "O"
aDataParams(11, 1) = "1034LA": aDataParams(11, 2) = "P"
aDataParams(12, 1) = "1034RA": aDataParams(12, 2) = "Q"
aDataParams(13, 1) = "1035L": aDataParams(13, 2) = "R"
aDataParams(14, 1) = "1035R": aDataParams(14, 2) = "S"
aDataParams(15, 1) = "1036L": aDataParams(15, 2) = "T"
aDataParams(16, 1) = "1036R": aDataParams(16, 2) = "U"
'Find minimum column
MinCol = wsInput.Columns.Count
For ParamIndex = LBound(aDataParams, 1) To UBound(aDataParams, 1)
If wsInput.Columns(aDataParams(ParamIndex, 2)).Column < MinCol Then MinCol = wsInput.Columns(aDataParams(ParamIndex, 2)).Column
Next ParamIndex
'Based on minimum column, determine column indexes for each sheet/column pair
For ParamIndex = LBound(aDataParams, 1) To UBound(aDataParams, 1)
aDataParams(ParamIndex, 3) = wsInput.Columns(aDataParams(ParamIndex, 2)).Column - MinCol + 1
Next ParamIndex
With wsInput.Range("F89", wsInput.Cells(wsInput.Rows.Count, "V").End(xlUp))
If .Row < 89 Then
MsgBox "No data in sheet [" & wsInput.Name & "]"
Exit Sub
End If
aInput = .Value
End With
For ParamIndex = LBound(aDataParams, 1) To UBound(aDataParams, 1)
'Define data sheet based on current column
Set wsData = wb.Sheets(aDataParams(ParamIndex, 1))
aData = wsData.Range("C1", wsData.Cells(wsData.Rows.Count, "F").End(xlUp)).Value
For InputIndex = LBound(aInput, 1) To UBound(aInput, 1)
For DataIndex = LBound(aData, 1) To UBound(aData, 1)
If aInput(InputIndex, UBound(aInput, 2)) >= aData(DataIndex, 3) _
And aInput(InputIndex, UBound(aInput, 2)) <= aData(DataIndex, 4) Then
aInput(InputIndex, aDataParams(ParamIndex, 3)) = aData(DataIndex, 1)
Exit For
End If
Next DataIndex
Next InputIndex
Set wsData = Nothing
Erase aData
Next ParamIndex
wsInput.Range("F89").Resize(UBound(aInput, 1), UBound(aInput, 2)) = aInput
Set wb = Nothing
Set wsInput = Nothing
Set wsData = Nothing
Erase aInput
Erase aData
Erase aDataParams
End Sub
I solved it on my own. I added a for loop. Here is my working code. Thanks to everyone else for trying to help.
Sub runMatch()
Dim critRemID, listRemID, critRemIDstart, listRemIDstart As Range
Set critRemID = Worksheets("Enterprise - score").Cells(2, 1)
Set listRemID = Worksheets("Sheet1").Cells(2, 1)
Set critRemIDstart = Worksheets("Enterprise - score").Cells(2, 30)
Set listRemIDstart = Worksheets("Sheet1").Cells(2, 2)
Dim i, j, index As Integer
i = 0
j = 0
Do While critRemID.Offset(i, 0) <> ""
If critRemID.Offset(i, 0) = listRemID.Offset(j, 0) Then
For index = 0 To 84
critRemIDstart.Offset(i, index) = listRemIDstart.Offset(j, index).Value
Next index
i = i + 1
j = 0
index = 0
Else
If listRemID.Offset(j, 0) = "" Then
j = 0
i = i + 1
Else
j = j + 1
End If
End If
Loop
End Sub
I have two sheets, they each have a the same IDs on each sheet but
different sets of data.
I want to scan through the rows of data and if there is a match, copy
the entire row from a certain column to another certain column to the
end of one of the sheets.
Sheet 1 is the sheet I want to copy info into, on the end I've created
the same headers for the data I want to bring over from sheet 2.
the code below is what I have, I set a range up for the IDs and one
for where I want the copied cells to start
Dim critRemID, listRemID, critRemIDstart, listRemIDstart As Range
Set critRemID = Worksheets("Enterprise - score").Cells(2, 1)
Set listRemID = Worksheets("Sheet1").Cells(2, 1)
Set critRemIDstart = Worksheets("Enterprise - score").Cells(2, 30)
Set listRemIDstart = Worksheets("Sheet1").Cells(2, 90)
Dim i, j As Integer
i = 0
j = 0
Do While critRemID.Offset(i, 0) <> ""
If critRemID.Offset(i, 0) = listRemID.Offset(j, 0) Then
critRemIDstart.Row(i) = listRemIDstart.Row(j).Value
i = i + 1
j = 0
Else
j = j + 1
End If
Loop
I keep getting this error
Wrong number of arguments or invalid property assignment
I tried going a different route but kept getting confused as shown
below. I was trying to have it copy each cell one by one and once it
reached an empty cell, it would move onto the next ID on the main
sheet and start over but this does nothing, I think it keeps
increasing both IDs on the sheet and never finds a match.
If critRemID.Offset(i, 0) = listRemID.Offset(j, 0) Then
critRemIDstart.Offset(i, k) = listRemIDstart.Offset(j, l).Value
k = k + 1
l = l + 1
Else
If listRemIDstart.Offset(j, l) = "" Then
j = j + 1
l = 0
i = i + 1
k = 0
Else
j = j + 1
i = i + 1
l = 0
k = 0
End If
End if
any help is appreciated. Thanks.
Range.Find method could find the key easily.
Dim critRem, listRem As Worksheet
Set critRem = Worksheets("Enterprise - score")
Set listRem = Worksheets("Sheet1")
Dim critRemID, listRemID, cell, matchedCell As Range
With critRem
Set critRemID = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
With listRem
Set listRemID = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
For Each cell In critRemID
Set matchedCell = listRemID.Find(cell.Value)
If matchedCell Is Nothing Then 'ID is not found
'Do nothing
Else 'ID is found, matchedCell is pointed to column A now
cell.Offset(0, 29).Resize(1, 10) = matchedCell.Offset(0, 89).Resize(1, 10)
'offset(0,29) means offsetting right 29 columns
'resize(0,10) means resizing the range with 1 row and 10 columns width
'feel free to change the number for your data
End If
Next cell
Note: If you are confused about offset().resize(), there is another approach. cell.Row gives you the row that the data should be written into, and matchedCell.Row gives you the row that the ID matched. So you can access certain cell by something like listRem.Range("D" & matchedCell.Row)
Tried to do it using the loop.
Sub Anser()
Dim critRemID As Range
Dim listRemID As Range
Dim critRemIDstart As Range
Dim listRemIDstart As Range
'::::Change Sheet names and column numbers:::::
Set critRemID = Worksheets("Sheet1").Cells(2, 1)
Set listRemID = Worksheets("Sheet2").Cells(2, 1)
Set critRemIDstart = Worksheets("Sheet1").Cells(2, 2)
Set listRemIDstart = Worksheets("Sheet2").Cells(2, 2)
Dim i, j As Integer
i = 0
j = 0
Do
If critRemID.Offset(i, 0) = listRemID.Offset(j, 0) Then
critRemIDstart.Offset(i) = listRemIDstart.Offset(j)
i = i + 1
j = 0
Else
j = j + 1
End If
Loop While critRemID.Offset(i, 0) <> ""
End Sub
If as you say both sheets have the same IDs, then why not use a Vlookup function to bring the data into Sheet1, then simply copy the results and paste as values so you get rid of the formula on them cells?
Something like a loop running:
For i = 1 to LastRow
Sheet1.cells(i, YourColumnNumber).value = "=VLOOKUP(RC[-1], Sheet2!R1:R1048576, 3, False)"
Next i
How to apply this from A4 instead of A2. Everything else I am happy with. I just want to understand any changes that I need to make to this.
Is it needing changes at "set population"? The 2?
Sub formatresults()
Dim lastRow As Long
Dim pop As Range
Dim rpSet As Range
Dim rpSetNames As Range
Dim sBeg As Integer
Dim sEnd As Integer
Dim rpName As String
Dim x As Integer
Dim y As Integer
lastRow = Range(Cells(99999, 1), Cells(99999, 1)).End(xlUp).row
Set pop = Range(Cells(2, 1), Cells(lastRow, 7))
sBeg = 2
sEnd = 2
y = 1
rpName = Cells(2, 1)
Range(Cells(1, 7), Cells(lastRow, 7)).NumberFormat = "0.00%"
For x = 2 To lastRow
If Cells(sEnd + 1, 1) = rpName Then
sEnd = sEnd + 1
Else
Set rpSet = Range(Cells(sBeg, 1), Cells(sEnd, 7))
Set rpSetNames = Range(Cells(sBeg, 1), Cells(sEnd, 1))
rpSet.BorderAround Weight:=xlMedium
If y Mod 2 = 1 Then rpSetNames.Interior.ColorIndex = 15
sBeg = sEnd + 1
sEnd = sEnd + 1
rpName = Cells(sBeg, 1)
y = y + 1
End If
Next x
End Sub
Many thanks!
I added a new variable StartFrom so that you'll only have to change the value once to make it work on a different range.
Also, I changed the definition of lastRow, take a look at Error in finding last used cell in VBA
Give this a try :
Sub formatresults()
Dim lastRow As Long
Dim pop As Range
Dim rpSet As Range
Dim rpSetNames As Range
Dim sBeg As Integer
Dim sEnd As Integer
Dim rpName As String
Dim x As Integer
Dim y As Integer, _
StartFrom As Integer
StartFrom = 4
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Set pop = Range(Cells(StartFrom, 1), Cells(lastRow, 7))
sBeg = StartFrom
sEnd = StartFrom
y = 1
rpName = Cells(StartFrom, 1) '----
Range(Cells(1, 7), Cells(lastRow, 7)).NumberFormat = "0.00%"
For x = StartFrom To lastRow '----
If Cells(sEnd + 1, 1) = rpName Then
sEnd = sEnd + 1
Else
Set rpSet = Range(Cells(sBeg, 1), Cells(sEnd, 7))
Set rpSetNames = Range(Cells(sBeg, 1), Cells(sEnd, 1))
rpSet.BorderAround Weight:=xlMedium
If y Mod 2 = 1 Then rpSetNames.Interior.ColorIndex = 15
sBeg = sEnd + 1
sEnd = sEnd + 1
rpName = Cells(sBeg, 1)
y = y + 1
End If
Next x
End Sub
I'm having issues with piece of code. We use the following to search a log for a specific information, populate a chart and then print and clear the chart once completed.
The thing is, if we change the search criteria from CIS to Inbound (or anything else for that matter) it refuses to populate the chart with the information from the log, but still prints out the chart headers.
This is the code we're using:
Private Sub cmdprint_Click()
Dim sdsheet As Worksheet, ersheet As Worksheet
Set sdsheet = Workbooks("HD Project.xls").Sheets("HelpdeskLogg")
Set ersheet = Workbooks("HD Project.xls").Sheets("report")
dlr = sdsheet.Cells(Rows.Count, 1).End(xlUp).Row
rlr = ersheet.Cells(Rows.Count, 1).End(xlUp).Row
y = 2
For x = 2 To dlr
If UCase(sdsheet.Cells(x, 6)) = "Inbound" And CDate(sdsheet.Cells(x, 3)) >= CDate(Me.txtdatestart) And CDate(sdsheet.Cells(x, 3)) <= CDate(Me.txtdateend) Then
ersheet.Cells(y, 1) = CDate(sdsheet.Cells(x, 3))
ersheet.Cells(y, 2) = sdsheet.Cells(x, 6)
ersheet.Cells(y, 3) = sdsheet.Cells(x, 7)
ersheet.Cells(y, 4) = sdsheet.Cells(x, 8)
ersheet.Cells(y, 5) = sdsheet.Cells(x, 9)
ersheet.Cells(y, 6) = sdsheet.Cells(x, 10)
ersheet.Cells(y, 7) = sdsheet.Cells(x, 11)
ersheet.Cells(y, 8) = sdsheet.Cells(x, 12)
ersheet.Cells(y, 9) = sdsheet.Cells(x, 13)
y = y + 1
'On Error Resume Next
End If
Next x
Dim Lastrow As Integer
Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Set printa = ersheet.Range("A1:i" & Lastrow)
printa.PrintOut
Sheets("report").Range("a2:i999").ClearContents
End Sub
Try changing:
UCase(sdsheet.Cells(x, 6)) = "Inbound" to
UCase(sdsheet.Cells(x, 6)) = "INBOUND"
Try changing:
UCase(sdsheet.Cells(x, 6)) = "Inbound" to
UCase(sdsheet.Cells(x, 6)) = "INBOUND"
This worked. Thank you for your help, barrleajo
I'm trying to add the items from a list to some rows in an Excel Sheet.
I tried to do it this way:
Dim Rand As Long
Dim ws As Worksheet
Set ws = Worksheets("Necmontage")
Rand = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Range(ws.Cells(Rand, 1), ws.Cells(Rand + necesar.ListCount - 1, 1)).Merge
ws.Cells(Rand, 1) = "K"
Range(ws.Cells(Rand, 2), ws.Cells(Rand + necesar.ListCount - 1, 2)).Merge
ws.Cells(Rand, 2) = "Montage"
Range(ws.Cells(Rand, 3), ws.Cells(Rand + necesar.ListCount - 1, 3)).Merge
ws.Cells(Rand, 3) = comanda.Caption
Dim i As Integer
i = 0
Do While i = necesar.ListCount - 1
ws.Cells(Rand + i, 4) = necesar.List(i, 0)
i = i + 1
Loop
End Sub
It adds all the values I want except the values from the List (where I do that While Loop). I don't know why but it doesn't take the values. Any idea about this problem?
Did you mean in your code:
Do While i <= necesar.ListCount - 1 'instead of =
ws.Cells(Rand + i, 4) = necesar.List(i, 0)
i = i + 1
Loop
Btw, you can see in debug mode by putting a breakpoint on the Do While line if the program goes where you wanted it to.