I want to read data from columns by for loop. It should starts on B2 and ends on G2. I want to read B2 value as a string, and put another value to G2 cell. I use cellValue variable as Range type, and deviceName to take out this value of cell (cells(1) because first cell in this cellValue range).
However I have got error like this:
"Invalid procedure call or argument"
For Row = 2 To rows
cellValue = ActiveSheet.Cells("B" & CStr(Row) & ":" & "G" & CStr(Row))
deviceName = cellValue.Cells(1)
// my code...
Next Row
Couldn’t find any obvious flaws above, but I changed it up a bit. This should work. I’m using Cells and only numbers for the iteration, rather than casting with Cstr.
Dim ws as worksheet
Dim fRow as Long
Set ws = ThisWorkbook.Worksheets(“Sheet1”)
With ws
fRow = .Cells(.Rows.Count,6).end(xlUp).Row
End with
For row = 2 to fRow
cellValue = ws.Range(Cells(2,row),Cells(6,row)).Value
deviceName = CellValue
Next row
Post an example for a range.
Sub test()
Dim cellValue As Range, vDB As Variant
Dim i As Long, r As Long
Dim deviceName
r = ActiveSheet.UsedRange.Rows.Count 'Set r to suit your situation.
'Row and rows are similar to reserved words in visual basic, so we don't recommend them.
For i = 2 To r
'Because range is an object, you must use the set statement.
Set cellValue = ActiveSheet.Range("B" & CStr(i) & ":" & "G" & CStr(i))
'same code above
Set cellValue = ActiveSheet.Range("B" & i & ":" & "G" & i) '<~~ When it is made by connecting letters and numbers, it becomes a letter.
Set cellValue = ActiveSheet.Range("B" & i, "G" & i) '<~~ The first part of the comma is the first cell in the region, and the last part is the last cell in the region.
Set cellValue = ActiveSheet.Range("B" & i).Resize(1, 6) '<~~ 1 is rows.count, 6 is columns.count ; Change the size of the range to the size of the resize statement.
'If the set statement is not used, it is an array of variants.
vDB = ActiveSheet.Range("B" & i & ":" & "G" & i) 'vDB is 2D array
deviceName = cellValue.Cells(1)
'same above code
deviceName = cellValue.Range("a1")
deviceName = cellValue(1)
deviceName = cellValue.Cells(1).Offset(0, 0)
'If you use arrays, vDB
deviceName = vDB(i, 1)
Next i
End Sub
Related
Please see an abstracted example in the image below
Warning! I'm very new to VBA and still learning, so there might be some obvious mistakes in my code.
I have a very large table of data containing several rows and columns. The objective is to loop through a column containing a bunch of IDs and detect duplicates in a specific segment of the string. As soon as there is a mismatch in this segment, the row and new value is stored before a reverse loop begins that shifts everything below down the last duplicate down by four spaces.
The result is three blank rows after all duplicates (see image).
There's a few conditions that I have to meet for this code to be compatible with the software that secures this sheet:
Inserting whole rows needs to be avoided, insert and shift down is okay
Avoiding select is ideal
No application enable/disable can be used
The fewer individual cell changes the better
The idea is to loop through each of the columns to shift all corresponding values in that row down once I have perfected the first column. It would be great to avoid having to do so if there's a way to shift the whole range down instead of individual cells.
The second, reverse loop seems to be the problem.
I've tried several ways of looping using integer loops, range for loops, do while, and do until.
Please let me know if you need clarification! Thank you so much for your help.
Sub shiftValues()
Dim ws1 As Worksheet
Set ws1 = Worksheets("Tab1=Raw Data")
Dim lastRow As Variant
lastRow = ws1.Range("A" & ws1.Rows.count).End(xlUp).Row
Dim cell As Range
Dim rng As Range
Set rng = ws1.Range("A16:A" & lastRow)
Dim oldString As String
Dim newString As String
newString = "newString"
Dim oldRow As Integer
oldRow = 15 'Start of table
Dim beforeEqual() As String
beforeEqual = Split(ws1.Range("A15").Value, "=")
Dim tar As Long
For Each cell In rng
oldString = Right(beforeEqual(0), 2)
If cell.Value <> vbNullString And Len(cell.Value) > 6 Then
beforeEqual = Split(cell.Value, "=")
newString = Right(beforeEqual(0), 2)
If newString <> oldString And cell.Row > 15 Then
oldString = newString
oldRow = cell.Row
tar = lastRow
Do Until tar = oldRow
Range("A" & tar + 4).Value = Range("A" & tar).Value
Range("A" & tar).ClearContents
tar = tar - 1
Loop
End If
End If
Next cell
End Sub
This may do what you want:
j = 0
For i = Range("A" & Rows.Count).End(xlUp).Row To 3 Step -1
If Range("A" & i).Value <> Range("A" & i - 1).Value And Range("A" & i - 1).Value <> Range("A" & i - 2).Value Then
If j = 0 Then
j = i
Else
End If
Else
If j > 0 Then
Range("A" & i & ":A" & i + 2).Insert Shift:=xlDown
j = 0
End If
End If
So I have what might be a simple issue. I have a worksheet where I'm just hoping to generate a row count starting with cell A4. So A4 = 1, A5 = 2 , etc. The problem is I'm not sure how to configure this with the following goal:
1 - I'm hoping the count starts with cell A4 and ends the count at the final row with data.
The code I have below only works if I manually put A4 = 1, and also populates formulas past the last row unfortunately.
Please help if this is possible.
Sub V14()
With ThisWorkbook.Worksheets("DCT")
.Cells(5, 1).Resize(.Cells(.Rows.Count, 2).End(xlUp).Row - 1).Formula = "=IF(DCT!B5="""","""",DCT!A4+1)"
End With
End Sub
Write Formula to Column Range
The Code
Sub V14()
Const wsName As String = "DCT" ' Worksheet Name
Const tgtRow As Long = 4 ' Target First Row Number
Const tgtCol As String = "A" ' Target Column String
Const critCol As String = "B" ' Criteria Column String
' Define worksheet ('ws').
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets(wsName)
' Define Last Non-Empty Cell ('cel') in Criteria Column ('critCol').
Dim cel As Range
Set cel = ws.Cells(ws.Rows.Count, critCol).End(xlUp)
' Define Target Column Range ('rng').
Dim rng As Range
Set rng = ws.Cells(tgtRow, tgtCol).Resize(cel.Row - tgtRow + 1)
' Define Target Formula ('tgtFormula').
Dim tgtFormula As String
tgtFormula = "=IF('" & wsName & "'!" & critCol & tgtRow _
& "="""","""",MAX('" & wsName & "'!" & tgtCol _
& "$" & tgtRow - 1 & ":" & tgtCol & tgtRow - 1 & ")+1)"
' Write Target Formula to Target Range.
rng.Formula = tgtFormula
' If you just want to keep the values:
'rng.Value = rng.Value
End Sub
I think you might just need an extra IF:
Sub V14()
With ThisWorkbook.Worksheets("DCT")
.Cells(4, 1).Resize(.Cells(.Rows.Count, 2).End(xlUp).Row - 1).Formula = "=IF(DCT!B4="""","""",IF(A3="""",1,SUM(DCT!A3,1)))"
End With
End Sub
Report any question you have or bug you have encountered. If, according to your judgment, this answer (or any other) is the best solution to your problem you have the privilege to accept it (link).
Dim target As String
Dim lastrow As Long
target = "A4"
lastrow = ActiveSheet.UsedRange.Rows.count
'for example
Range(target) = "1"
Range(target).Offset(1, 0) = "2"
Range(Range(target),Range(target).Offset(1, 0)).Select
Selection.AutoFill Destination:=Range(target & ":A" & lastrow + Range(target).Row - 1), Type:=xlFillDefault
You only got to change the target cell, this does the rest.
I wanted to convert below formula to VBA code.
=C1&"`"&K1&"`"&L1&"`"&J1
=VLOOKUP(M1,Data!$A:$J,9,)
=SUMPRODUCT(SUMIF(B1:B,B1,G1:G))
Currently i have enter this formula in 1st row and than copying this formula till the last row used which is taking lot time to apply formula because it has more than million row.
LR1 = Sheets("CRIMS").UsedRange.Rows.Count
Sheets("CRIMS").Range("M1:P1").AutoFill Destination:=Sheets("CRIMS").Range("M1:P" & LR1)
is there any way to convert this formula into VBA code?
For first formula the easiest way would be:
Range("M" & i).FormulaR1C1 = "=RC[-10]&""`""&K&""`""&L&""`""&J"
But for vlookup I prefer dictionaries/collections! It is much much faster.
If You have source data in Data sheet and You want to put that to CRIMS sheet to column M:
Sub vlookup()
Dim names As Range, values As Range
Dim lookupNames As Range, lookupValues As Range
Dim vlookupCol As Object
Dim lastRow As Long
Dim lastRow2 As Long
Dim objekt as Object
With Sheets("Data")
lastRow = Sheets("Data").Cells(Rows.Count, 1).End(xlUp).row
Set names = Sheets("Data").Range("A1:A" & lastRow)
Set values = Sheets("Data").Range("I1:A" & lastRow)
End With
Set objekt = BuildLookupCollection(names, values)
With Sheets("CRIMS")
lastRow2 = 1000000
Set lookupNames = .Range("M1:M" & lastRow)
Set lookupValues = .Range("N1:N" & lastRow)
End With
VLookupValues lookupNames, lookupValues, objekt
Set objekt = Nothing
End Sub
Function BuildLookupCollection(categories As Range, values As Range)
Dim vlookupCol As Object, i As Long
Set vlookupCol = CreateObject("Scripting.Dictionary")
On Error Resume Next
For i = 1 To categories.Rows.Count
Call vlookupCol.Add(CStr(categories(i)), values(i))
Next i
On Error GoTo 0
Set BuildLookupCollection = vlookupCol
End Function
Sub VLookupValues(lookupCategory As Range, lookupValues As Range, vlookupCol As Object)
Dim i As Long, resArr() As Variant
ReDim resArr(lookupCategory.Rows.Count, 1)
For i = 1 To lookupCategory.Rows.Count
resArr(i - 1, 0) = vlookupCol.Item(CStr(lookupCategory(i)))
Next i
lookupValues = resArr
End Sub
Quotation Marks need to be doubled in VBA
Try this:
For i = 1 To LR1
Range("M" & i).Formula = "=C" & i & "&""`""&K" & i & "&""`""&L" & i & "&""`""&J" & i
Range("N" & i).Formula = "=VLOOKUP(M" & i & ",Data!$A:$J,9,)"
Next i
(replace column letters with actual target column)
As mentioned in the comments Looping in this case is highly inefficient.
Use this Code to insert the formulas all at once. It still takes some time for 1 Milion rows though.
Range("M1:M" & LR1).Formula = "=C:C & ""`"" & K:K & ""`"" & L:L & ""`"" & J:J"
Range("N1:N" & LR1).Formula = "=VLOOKUP(M:M,Data!$A:$J,9,)"
The below code needs to run the =disvincenty formula on a loop, and the referenced cells $C$2,$D$2 need to go down one row each time in same column each time code block runs until ABF (Last row with data in column T.) then it exit's sub
For each row, it needs to run the formulas =Min and the two =small's in the same columns already referenced, but also dropping down one row at a time - the same as the =distvincenty, but values being pasted each time to preserve result.
So =distvincenty is looking at two criteria in cells next to each other on same row, compares to a list running down a column, applies the three other formulas to that row, and moves down.
Dim rng As Range
Dim row As Range
Dim cell As Range
Dim ABF As Integer
ABF = Sheet9.Range("T" & Rows.Count).End(xlUp).row
Set rng = Range("Q2:Q" & ABF)
For Each row In rng.Rows
For Each cell In row.Cells
Sheet9.Range("Q2").Formula = "=distVincenty($C$2,$D$2,$R2,$S2)/1609.344"
Sheet9.Range("Q2").Copy
Sheet9.Range("Q2:Q" & ABF).PasteSpecial xlPasteAll
Application.CutCopyMode = False
Sheet9.Range("E2").Formula = "=MIN(Q:Q)"
Sheet9.Range("H2").Formula = "=SMALL(Q:Q,2)"
Sheet9.Range("K2").Formula = "=SMALL(Q:Q,3)"
Next cell
Next row
UPDATE:
I now have this:
Dim ABF As Integer
Dim i As Integer
For i = 2 To Sheet9.Range("A" & Rows.Count).End(xlUp).row
ABF = Sheet10.Range("AC" & Rows.Count).End(xlUp).row
Sheet10.Range("AE3").Formula = "=distVincenty('Booking Workings'!$C$2,'Booking Workings'!$D$2,'User List'!$Z3,'User List'!$AA3)/1609.344"
Sheet10.Range("AE3").Copy
Sheet10.Range("AE3:AE" & ABF).PasteSpecial xlPasteAll
Application.CutCopyMode = False
Sheet9.Range("E" & i).Formula = "=MIN('User List'!AE:AE)"
Sheet9.Range("H" & i).Formula = "=SMALL('User List'!AE:AE,2)"
Sheet9.Range("K" & i).Formula = "=SMALL('User List'!AE:AE,3)"
Next i
End sub
The only problem I have is that each time this code runs, I need the $C$2 and $D$2 to change like the simpler formulas.
Can I do this?
Sheet10.Range("AE3").Formula = "=distVincenty('Booking Workings'!$C$"(I)",'Booking Workings'!$D$"(I)",'User List'!$Z3,'User List'!$AA3)/1609.344"
UPDATE
looks like this works:
"=distVincenty('Booking Workings'!$C$" & (i) & ",'Booking Workings'!$D$" & (i) & ",'User List'!$Z3,'User List'!$AA3)/1609.344"
This is hard to explain. Let me know if I'm close.
Sub Test()
Dim rng As Range
Dim row As Range
Dim cell As Range
Dim ABF As Integer
Dim arrValues
Dim count As Integer
ABF = Sheet9.Range("T" & Rows.count).End(xlUp).row
Set rng = Range("Q2:Q" & ABF)
arrValues = rng.Value
For Each cell In rng
Sheet9.Range("Q2:Q" & ABF).Formula = "=distVincenty($C$" & cell.row & ",$D$" & cell.row & ",$R2,$S2)/1609.344"
Sheet9.Range("E2").Formula = "=MIN(Q:Q)"
Sheet9.Range("H2").Formula = "=SMALL(Q:Q,2)"
Sheet9.Range("K2").Formula = "=SMALL(Q:Q,3)"
count = count + 1
arrValues(count) = cell.Value
Next cell
Sheet9.Range("Q2:Q" & ABF).Value = arrValues
End Sub
I have a text string that is using the ^ symbol as a delimiter.
I need to separate the text into new rows rather than new columns.
I need to create new rows to not overwrite the next line of data below it.
Is this possible without using a macro? I'm not against using one, I just wouldn't know where to start to write it.
Below is a pic of some sample data. The top part is how it's listed, and the bottom (in yellow) is how I would like it.
Using Excel 2010 on Windows 7 Pro.
Thanks to those that responded. A friend was able to help by providing the following code:
Sub Breakout()
Application.ScreenUpdating = False
LR = Cells(Rows.Count, 1).End(xlUp).Row
For r = LR To 2 Step -1
Set MyCell = Cells(r, 1)
Arry = Split(MyCell.Value, "^")
For c = 0 To UBound(Arry)
If c > 0 Then MyCell.Offset(c, 0).EntireRow.Insert
MyCell.Offset(c, 0) = Arry(c)
Next c
Next r
End Sub
Could try something like this:
Sub reArrange()
Dim inFirstRng As Range
Dim inRng As Range
Dim inCur As Variant
Dim outFirstRng As Range
Dim outCurRng As Range
Dim ws As Worksheet
'CHANGE ARGUMENT TO YOUR SHEET NAME
Set ws = Worksheets("Sheet2")
With ws
'CHANGE ARGUMENT TO WHATEVER THE FIRST CELL OR YOUR DATA INPUT IS IN COLUMN A
Set inFirstRng = .Range("A3")
Set inRng = .Range(inFirstRng, inFirstRng.End(xlDown))
'CHANGE ARGUMENT TO WHATEVER THE FIRST CELL OR YOUR DATA OUTPUT IS IN COLUMN A
Set outFirstRng = .Range("A9")
Set outCurRng = outFirstRng
End With
For Each cell In inRng.Cells
inCur = WorksheetFunction.Transpose(Split(cell.Value, "^"))
outCurRng.Resize(UBound(inCur), 1).Value = inCur
With ws
.Range("G" & outCurRng.Row & ":L" & outCurRng.Row).Value = _
.Range("G" & cell.Row & ":L" & cell.Row).Value
End With
Set outCurRng = outCurRng.Offset(UBound(inCur), 0)
Next cell
ws.Range("F" & outFirstRng.Row & ":F" & outCurRng.Row - 1).Value = 1
End Sub