I have 20 textBoxes on a vba userform these textBoxes are supposed to take their values from a barcode reader and i created a while loop to take the values from those textboxes and input them on the next empty row , but when i check the results i get 2 problems
J = 0
While J < 20
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
ws.Range("A" & LastRow).Value = Now()
ws.Range("B" & LastRow).Value = Me.Controls("TextBox" & J + 1).Value
ws.Range("D" & LastRow).Value = Me.Controls("TextBox" & J + 2).Value
ws.Range("I" & LastRow).Value = TextBox21.Value
J = J + 1
Wend
The Quantity inserted on column D is Repeated on the Next Row Column B
Even If the TextBoxes are Empty It is still placing data As you can see on the highlighted in Red
Will post as an answer so it can be marked as such, though I listed this in a comment:
J = 0
While J < 20
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
ws.Range("A" & LastRow).Value = Now()
ws.Range("B" & LastRow).Value = Me.Controls("TextBox" & J*2 + 1).Value
ws.Range("D" & LastRow).Value = Me.Controls("TextBox" & J*2 + 2).Value
ws.Range("I" & LastRow).Value = TextBox21.Value
J = J + 1
Wend
May want to check your J max after this...
row 1 uses J = 0, so textbox 1, textbox 2
row 2 uses j = 1, so textbox 1*2+1 (3) and textbox 1*2+2 (4)
row 3 uses j =2, so textbox 2*2+1 (5) and textbox 2*2+2 (6)
etc.
Related
I have an Excel sheet (doc1) with 4 columns. In "A" I have people names. In "B","C" and "D", I have informations on the CV of each of these people. I would like to extract in another sheet (doc2) these informations in a specific format: For each CV information, I would like to insert a row with the name of the person in "A" and one information about his CV in "B". Basically if I have 3 informations about a person in doc1 (In B,C and D), I want to have 3 rows : In A1, A2 and A3 the name of the person, and in B1, B2 and B3 the person's infos.
I have a macro which does the exact opposite, it is basically doing a Vlookup which throws multiple results. Any idea on how to turn this around? Thanks!
Option Explicit
Sub GO()
Dim J As Long
Dim I As Integer
Dim K As Long
Dim Indice As Long
Dim Tablo
Dim Nb As Integer
Application.ScreenUpdating = False
ReDim Tablo(1 To Range("A" & Rows.Count).End(xlUp).Row - 2, 1 To 2)
Tablo(1, 1) = Range("A2")
Tablo(1, 2) = Range("B2")
Nb = 1
For J = 3 To Range("A" & Rows.Count).End(xlUp).Row
For K = 1 To UBound(Tablo)
If Range("A" & J) = Tablo(K, 1) Then
For I = 1 To UBound(Tablo, 2)
If Tablo(K, I) = "" Then
Tablo(K, I) = Range("B" & J)
Exit For
End If
Next I
If I > UBound(Tablo, 2) Then
ReDim Preserve Tablo(1 To UBound(Tablo), 1 To UBound(Tablo, 2) + 1)
Tablo(K, UBound(Tablo, 2)) = Range("B" & J)
End If
Exit For
ElseIf Tablo(K, 1) = "" Then
Nb = Nb + 1
Tablo(K, 1) = Range("A" & J)
Tablo(K, 2) = Range("B" & J)
Exit For
End If
Next K
Next J
With Sheets("doc2")
.Cells.ClearContents
.Range("A2").Resize(Nb, UBound(Tablo, 2)) = Tablo
.Range("A1") = "Name"
.Range("B1") = "C.V info 1"
.Range("B1").AutoFill .Range("B1").Resize(, UBound(Tablo, 2) - 1), xlFillSeries
End With
End Sub
try somethihng like this:
Function NeverCallAFunctionGO:
dim doc1 as worksheet, doc2 as worksheet
dim lRow as long
'set your doc1 and doc2 sheets
lRow = 1
For i = 1 to doc1.range("A1").end(xldown).row
doc2.range("A" & lRow).value = doc1.range("A" & i).value
doc2.range("B" & lRow).value = doc1.range("B" & i).value
doc2.range("B" & lRow+1).value = doc1.range("C" & i).value
doc2.rangE("B" & lRow+2).value = doc1.rangE("D" & i).value
lRow = lRow + 3
Next i
I am surprised there's no answer for this. I have read Setting Dynamic Ranges in VBA and Selecting Dynamic Range and Autofill Dynamic Range Last Row and Last Column and MSDN
I have multiple, distinct ranges on a sheet with varying sizes. I am trying to subtotal column L. I can do it using a hardcoded sum (via subtotal variable) but I want to insert a formula into the cell instead. This requires knowing the starting and end rows for each range. My code almost works. It fails when the range only consists of one row. Even so, I feel there's gotta be a smarter way to do this.
How does one determine the start and end row of a range on a sheet filled with multiple ranges?
For i = 2 To j
If .Cells(i + 1, "L") = "" And .Cells(i + 2, "L") = "" Then
b = .Cells(i - 1, "J").End(xlUp).Row
End If
subtotal = subtotal + .Cells(i, "L").Value2
If .Cells(i, 1) = "" And .Cells(i - 1, "B") <> "" Then
If .Cells(i - 1, "K") = 0 Then
.Cells(i, "K").Value2 = "Check Payment"
'Set sumRng = .Range(.Cells(b, "L"), .Cells(i - 1, "L"))
.Cells(i, "L").Formula = "=sum(L" & b & ":L" & i - 1 & ")"
.Cells(i - 1, "L").Borders(xlEdgeBottom).LineStyle = xlContinuous
total = total + subtotal
subtotal = 0
ElseIf .Cells(i - 1, "K") = "Checking" Then
.Cells(i, "K").Value2 = "EFT Payment"
'Set sumRng = .Range(.Cells(b, "L"), .Cells(i - 1, "L"))
.Cells(i, "L").Formula = "=sum(L" & b & ":L" & i - 1 & ")"
.Cells(i - 1, "L").Borders(xlEdgeBottom).LineStyle = xlContinuous
total = total + subtotal
subtotal = 0
End If
End If
Next
You can loop through the column like this:
For i = 2 To mySheet.Range("B" & Rows.Count).End(xlUp).Row + 1
If Range("B" & i).Value <> vbNullString Then
If Range("B" & i - 1).Value = vbNullString Then
j = i
End If
Else
If Range("B" & i - 1).Value <> vbNullString And Range("B" & i - 1).Formula <> "=SUM(B" & j & ":B" & i - 2 & ")" Then
Range("B" & i).Formula = "=SUM(B" & j & ":B" & i - 1 & ")"
End If
End If
Next i
This uses Match to skip chunks and as such the number or loops are less
With ActiveSheet
Dim b As Long
b = 2
Do Until b = .Rows.Count
Dim x As Variant
x = .Evaluate("Match(True, Index(" & .Range(.Cells(b, "l"), .Cells(.Rows.Count, "l")).Address & " <> """",),0)")
If Not IsError(x) Then
b = b + x - 1
Else
Exit Sub
End If
x = .Evaluate("Match(True, Index(" & .Range(.Cells(b, "l"), .Cells(.Rows.Count, "l")).Address & " = """",),0)")
Dim i As Long
i = b + x - 1
.Cells(i, "l").Formula = "=sum(L" & b & ":L" & i - 1 & ")"
b = i + 2
Loop
End With
My main problem is that I am trying to add a row directly beneath another row based on the time value of that row. Here's an example of what I'm trying to do:
column F ========> new column F
2 1
2
2 1
2
1 1
1 1
2 1
2
To better explain, if the value in the first column F is a 2, that represents a time value that is greater than 0:59:00 and another row is added beneath it. If it is a 1, then it represents a time value that is equal to or less than 0:59:00and no row gets added.
I have multiple coding attempts at fixing this, and this first one is by someone more well-versed in VBA than I and includes some of his comments:
Public Sub ExpandRecords()
Dim i As Long, _
j As Long, _
LR As Long
'set variable types
LR = Range("A" & Rows.Count).End(xlUp).Row
'setting variable LR as number of rows with data
Application.ScreenUpdating = False
Columns("F:F").NumberFormat = "hh:mm:ss"
'sets number format in column b to text
For i = LR To 1 Step -1
'Executes following code from last row with data to row 1 working backwards
'If CLng(Left(Range("F" & i).Value, Len(Range("F" & i).Value) - 6)) > 0 Then
If CLng(Hour(Range("F" & i))) > 0 Then
'If the hour value in column F is greater than 1, then...
With Range("F" & i)
'starting with column F, loop through these statements...
'.Offset(1, 0).Resize(CLng(Left(Range("F" & i).Value, Len(Range("F" & i).Value) - 6)) - 1, 1).EntireRow.Insert Shift:=xlDown
.Offset(1, 0).Resize(CLng(Hour(Range("F" & i))).Value, Len(Range("F" & i).Value) - 1, 1).EntireRow.Insert Shift:=xlDown
'return the value of column F's hour value, change the range to insert the number of rows below based on hour value
'.Resize(CLng(Left(Range("F" & i).Value, Len(Range("F" & i).Value) - 6)), 1).EntireRow.Value = Range("A" & i).EntireRow.Value
.Resize(Hour(Range("F" & i)), 1).EntireRow.Value = Range("A" & i).EntireRow.Value
'Get value of row to be copied
'For j = 0 To CLng(Left(Range("F" & i).Value, Len(Range("F" & i).Value) - 6))
For j = 0 To Hour(Range("F" & i))
Range("H" & i).Offset(j - 1, 0).Value = Application.Text(j, "0")
Next j
End With
Else
Range("H" & i).Value = Application.Text(1, "0")
End If
Next i
Application.ScreenUpdating = True
End Sub
Here is a similar question from a previous user
Any help would be greatly appreciated.
Use this instead:
Public Sub ExpandRecords()
Dim i As Long, s As String
Const COL = "F"
For i = 1 To Cells(Rows.Count, COL).End(xlUp).Row
If Cells(i, COL) = 2 Then s = s & "," & Cells(i, COL).Address
Next
If Len(s) Then
Range(Mid$(s, 2)).EntireRow.Insert
For i = 1 To Cells(Rows.Count, COL).End(xlUp).Row
If Cells(i, COL) = vbNullString Then Cells(i, COL) = 1
Next
End If
End Sub
I have a sheet:
I am trying to write code to be able to combine multiple values into one row, I need to sum the values from columns, B, C and D.
My aim is to be able to press a button and I have all of my duplicate values removed, but before this, the numerical values in the adjacent columns are summed into the single version.
So far I have removed the duplicates from the column:
Sheets("Sheet4").Select
With Columns("A:A")
.Replace What:="mobile", Replacement:=""
End With
Previous code should do your job. It may need a fine tuning but idea would work. Do not forget to make proper addressing of worksheets for your ranges. I did not do it. This will work on the active sheet currently.
Update: Updated with worksheet addresses.
Dim ws As Worksheet
Dim LastRow As Long
Dim S_Value As String
Set ws = Sheets("Sheet1")
LastRow = Range("A" & Rows.Count).End(xlUp).Row
i = 2
While i <= LastRow
S_Value = ws.Range("A" & i).Value
j = i + 1
While j <= LastRow
If ws.Range("A" & j).Value = S_Value Then
ws.Range("B" & i).Value = ws.Range("B" & i).Value + ws.Range("B" & j).Value
ws.Range("C" & i).Value = ws.Range("C" & i).Value + ws.Range("C" & j).Value
ws.Range("D" & i).Value = ws.Range("D" & i).Value + ws.Range("D" & j).Value
ws.Rows(j & ":" & j).EntireRow.Delete
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
j = j - 1
End If
j = j + 1
Wend
i = i + 1
Wend
Here you go,
Sub SumCount()
Dim s, c, sm
Dim Rws As Long, Rng As Range
Rws = Cells(Rows.Count, "B").End(xlUp).Row
Set Rng = Range(Cells(2, 2), Cells(Rws, 4))
s = InputBox("What Number to Find?")
c = Application.WorksheetFunction.CountIf(Rng, s)
sm = s * c
MsgBox sm
End Sub
I have some datas where there are multiple duplicates in column E and its dept no. in column S. What I want to do is, for any duplicate value in col E if the values of Col S are same, then it should retain the same value in the 1st duplicate and delete other duplicates. If the Col S values are not same, it should have the value as "18" in it. Eg
Col E Col S Ans
1515A 10 Retain no changes
1515AA 12 Retain as 1515AA in Col A and 12 as Col S
1515AA 12 Delete
1515AA 12 Delete
5151B 8 Retain no changes
515BB 5 Take 515BB with 18
515BB 3 Delete
I have nearly 800-1500 line items. Can anyone help me with a macro. It will be very useful for me, instead of manually finding and deleting datas.
You can use something like:
Sub EraseR()
i = 1
While Range("E" & i).Value <> ""
If (Range("E" & i + 1).Value = Range("E" & i).Value) And (Range("S" & i + 1).Value = Range("S" & i).Value) Then
Range(i + 1 & ":" & i + 1).Delete
ElseIf (Range("E" & i + 1).Value = Range("E" & i).Value) And (Range("S" & i + 1).Value <> Range("S" & i).Value) Then
Range(i + 1 & ":" & i + 1).Delete
Range("S" & i).Value = 18
Else
i = i + 1
End If
Wend
End Sub