I having a problem on the code below.
On row 130 i need to insert blank rows equal to the value in J.
The code now is inserting blank rows equal to J but is starting on row J. I need to start on row k and then insert blank rows of J. How do I define the starting row and the number of blank rows?
70 j = ws1.Cells(ws1.Rows.Count, "E").End(xlUp).Row
80 k = 2
90 x = 1
100 Do While x < j
110 With ws2
120 If j > 0 Then
'Insert J number of rows starting on row = k
130 .Rows(j).Resize(LastRow).Insert
140 For i = 2 To rngtocopy.Rows.Count
150 With ws2.Range("K" & k)
160 .Offset(0, 0).Value = rngtocopy(i, 1)
170 .Offset(0, 1).Value = rngtocopy(i, 2)
180 End With
190 k = k + 1
200 Next i
210 End If
220 End With
230 x = x + 1
240 Loop
I don't know if I understand your question correctly, but try this:
Set ws1 = Sheets("Calc")
Set ws2 = Sheets("Dealer Orders")
LastRow = ws1.Cells(ws1.Rows.Count, "E").End(xlUp).Row
Set rngtocopy = ws1.Range("E2", ws1.Cells(LastRow, "F"))
For i = 1 To rngtocopy.Rows.Count
With ws2.Range("K2")
.Resize(, 2).Insert xlDown
.Offset(-1, 0).Value = rngtocopy(i, 1)
.Offset(-1, 1).Value = rngtocopy(i, 2)
End With
Next
Is this somehow what you're trying? HTH.
Related
So I have a column A where the cells from 143 to 179 can be filled in with data if required. The loop takes the data from A and removes cells that have not been filled in getting rid of all the spaces (apart from a few listed required for formatting) and puts them into column C.
So, problem is that the script copies from 143 to 179 even if only 4 of the cells were filled in which looks strange when copied onto our system as there is a massive space. Is there a way to have it so it just copies/selects what's filled in, ex C143:"C"&counter ?
For i = 143 To 179
If i = 163 Or i = 165 Or i = 174 Then counter = counter + 1
If Cells(i, 1).Value <> "" Then
Cells(counter + 143, 3).Value = Cells(i, 1).Value
counter = counter + 1
End If
Next i
Range("C143:C179").Select
Selection.Copy
Your question is a bit unclear, but if you just want to copy the cells that have values in column A, to column c, starting from cell C1, this could do the job. I am not sure why you wanted to skip some of the rows, but I commented that out, however if you really need that you can bring it back to the code.
Sub test()
Dim i As Integer
Dim WS As Worksheet
Set WS = ActiveSheet
counter = 1
For i = 143 To 179
'If i = 163 Or i = 165 Or i = 174 Then counter = counter + 1
If WS.Cells(i, 1).Value <> "" Then
WS.Cells(counter, 3).Value = WS.Cells(i, 1).Value
counter = counter + 1
End If
Next i
WS.Range("C1:C" & counter - 1).Select
Selection.Copy
End Sub
Set the value up as a variable. Something like this:
For i = 143 To 179
If i = 163 Or i = 165 Or i = 174 Then counter = counter + 1
If Cells(i, 1).Value <> "" Then
Cells(counter + 143, 3).Value = Cells(i, 1).Value
counter = counter + 1
End If
Next i
lastrow1 = Cells(Rows.Count, "A").End(xlUp).Row
Range("C143:C" & lastrow1).Select
Selection.Copy
My problem is the as follows:
I have 3 columns and 20 rows, that contains numbers.
There is a line with numbers between 1 to 20 in order crescente, the other cells contains bigger numbers then 100 or whatever.
My homework is that I have to write a VBA code which fill color the cells that contains the line. This way i going to have a "colorful snake" from the cells that contains the numbers between 1 to 20.
Of course, the starting number cell is "A1"
the ending cell can be anywhere in the area "A1:C20"
the substance is the colored cells must have follow the numbers in order cresence!
Sub MeykEhYewowSnakhey()
Dim r, c
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets(1)
For r = 1 To ws.UsedRange.Rows.Count
For c = 1 To ws.UsedRange.Columns.Count
If ws.Cells(r, c).Value < 100 Then
ws.Cells(r, c).Interior.ColorIndex = 6
End If
Next
Next
End Sub
Try that.
There is probably a much more efficient way to solve this but this is my solution.
Sub Snake()
Dim wbk As Workbook
Dim ws As Worksheet
Dim mySnake As Integer, x As Integer, y As Integer
Set wbk = Workbooks("Book1.xlsm")
Set ws = wbk.Worksheets("Sheet1")
x = 1
y = 1
With ws
For mySnake = 1 To 20
If .Cells(x, y) = mySnake Then
.Cells(x, y).Interior.Color = vbYellow
'Check cell below
If .Cells(x + 1, y) = mySnake + 1 Then
x = x + 1
'Check cell to right
ElseIf .Cells(x, y + 1) = mySnake + 1 Then
y = y + 1
'Check cells to left if y <> 1
ElseIf y <> 1 Then
If .Cells(x, y - 1) = mySnake + 1 Then
y = y - 1
End If
'Check cells above if x <> 1
ElseIf x <> 1 Then
If .Cells(x - 1, y) = mySnake + 1 Then
x = x - 1
End If
End If
End If
Next mySnake
End With
End Sub
I am doing automation on matching Data form row Data1 to Data 2,
I was done by looping statement but the problem is take much time, when number of row increase
For that reason i planed do by vlookup, In vlookup only return first occurrence cell but i need to find all match cell and highlighted matched row ,which i show in figure.
Working with cells directly reduces the code performance. Try to set Data1 and Data2 to arrays and work with arrays.
Something like this:
With ActiveSheet
arr = .Range(.[A2], .Cells(.Rows.Count, "A").End(xlUp)).Value
arr2 = .Range(.[D2], .Cells(.Rows.Count, "D").End(xlUp)).Value
For i& = 1 To UBound(arr)
For j& = 1 To UBound(arr2)
If arr(i, 1) = arr2(j) Then
...
End If
Next j
Next i
End With
Hope you are looking for this
Sub testvlookup()
Dim lastrow, lastrowdata, incre, i, j As Long
lastrow = Range("A" & Rows.Count).End(xlUp).Row
lastrowdata = Range("D" & Rows.Count).End(xlUp).Row
incre = 6
For i = 2 To lastrow
For j = 2 To lastrowdata
If Range("A" & i).Value = Range("D" & j).Value Then
Range("D" & j, "G" & j).Interior.ColorIndex = incre
End If
Next j
incre = incre + 1
Next i
End Sub
I don't see the point why it should be to slow for many rows, it would be good to have more informations about that.
I would do it like the others, takes ~1 sec with 100000 comparisons.
Dim i As Integer
Dim b As Integer
i = 1
While i < 20000
Range("A1:A5").Copy Range(Cells(i, 4), Cells(i + 5, 4))
i = i + 5
Wend
MsgBox ("hi")
i = 1
While i < 7
b = 3
While b < 20000
If Cells(i, 1).Value = Cells(b, 4).Value Then
Cells(b, 4).Interior.ColorIndex = i
End If
b = b + 1
Wend
i = i + 1
Wend
End Sub
I'm looking for a way for copying down all data found between a range and paste it in a next column.
A= text data
B= Random numbers but always starting from 1
C= some data
D= My needed solution
Example:
A B C D
018404.00 1 20 20
018404x0 2 0 20
018404f1 2 0 20
018404v1 3 0 20
11000-0532 4 0 20
1004-1101 5 0 20
0720-0125 3 0 20
0810-0001 3 0 20
0710-0040 3 0 20
052269.00 1 0 80
052269v6 2 0 80
11001-0000 3 0 80
1001-1110 4 0 80
0720-0500 2 0 80
0810-0001 2 80 80
0720-0002 2 0 80
052275.00 1 0 160
052275v2 2 160 160
When the value in column B is 1 then find value in column C (in Range B:B from 1 to 1) copying it to D
I have tried it with a formula but this limits the depth. If value on Column C isto far from the 1 row it doesn't work.
=IF(AND(B2=1;C2=0);IF(B3=1;0;IF(C3=0;IF(C4=0;C5;C4);C3));IF(C2>0;C2;I1))
So I think I need a vba solution.
i think you need something like this.
This code search max value between your 1 and 1 value
Sub FindValBetweenOne()
Dim LastRow As Long
Dim FindVal As Long
LastRow = Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
For I = 1 To LastRow
If Cells(I, "B").Value = 1 Then 'find next "1"
FindVal = Cells(I, "C").Value
J = I + 1
Do While (J <= LastRow And Cells(J, "B").Value <> 1)
If Cells(J, "C").Value > FindVal Then
FindVal = Cells(J, "C")
End If
J = J + 1
Loop
End If
Cells(I, "D").Value = FindVal
Next I
End Sub
I am using a barcode scanner to do inventory with large quantities and I want to enter the data into excel. I can change the way that the scanner behaves after each scan to do things like tab, return, etc. but my big problem is that in order to efficiently provide the quantity I have to scan the item code (7 digits) and then scan the quantities from 0 to 9 in succession. Such that 548 is really 5, 4, 8 and when using excel it puts each number into a new cell. What I would like to do, but don't have the VBA chops to do it is to have excel check to see if the length is 7 digits or one digit. For each one digit number it should move the number to the next cell in the same row as the previous 7 digit number such that each successive one digit number is combined as if excel were concatenating the cells. Then it should delete the single digits in the original column and have the next row start with the 7 digit barcode number.
I hope this makes sense.
Example:
7777777
3
4
5
7777778
4
5
6
7777779
7
8
9
Should become:
| 7777777 | 345 |
| 7777778 | 456 |
| 7777779 | 789 |
Thanks!!
I set up my worksheet like this:
then ran the below code
Sub Digits()
Application.ScreenUpdating = False
Dim i&, r As Range, j&
With Columns("B:B")
.ClearContents
.NumberFormat = "#"
End With
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
Set r = Cells(i, 1)
If Len(r) = 7 Then
j = 1
Do Until ((Len(r.Offset(j, 0).Text) = 7) Or (IsEmpty(r.Offset(j, 0))))
Cells(i, 2) = CStr(Cells(i, 2).Value) & CStr(r.Offset(j, 0))
j = j + 1
Loop
End If
Set r = Nothing
Next
For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If Len(Cells(i, 1)) < 7 Then Rows(i & ":" & i).Delete
Next i
Columns.AutoFit
Application.ScreenUpdating = True
End Sub
and the results Ive got:
This is what I did with what you started but I think your newer solution will work better. Thank you so much mehow!
Sub Digits()
Application.ScreenUpdating = False
Dim i, arr, r As Range
Dim a, b, c, d, e
Dim y
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
Set r = Cells(i, 1)
Set a = Cells(i + 1, 1)
Set b = Cells(i + 2, 1)
Set c = Cells(i + 3, 1)
Set d = Cells(i + 4, 1)
Set e = Cells(i + 5, 1)
If Len(a) = 7 Then
y = 0
ElseIf Len(b) = 7 Then
y = 1
ElseIf Len(c) = 7 Then
y = 2
ElseIf Len(d) = 7 Then
y = 3
ElseIf Len(e) = 7 Then
y = 4
Else:
y = 0
End If
If Len(r) = 7 Then
arr = Range("A" & i & ":A" & i + y).Value
Range("B" & i & ":F" & i) = WorksheetFunction.Transpose(arr)
End If
Next
Cells.Replace "#N/A", "", xlWhole
Application.ScreenUpdating = True
End Sub