I have the following code:
Case "END-BOX"
EndBox = ActiveCell.Row
Selection.Offset(-1, 2).Select
Selection.ClearContents
Rows(2).Insert Shift:=xlDown
TotalCols = ActiveSheet.UsedRange.Columns.Count
Col = 4
Cells(EndBox, Col).Select
For i = EndBox To 1 Step -1
If Cells(i, Col).Value <> "" Then
n = n + 1
Else
Cells(i, Col).Value = n
If Cells(i, Col).Offset(0, -2).Value = "NEW-BOX" Then Cells(i, Col).Interior.ColorIndex = 4
n = 0
' Application.Speech.Speak (n)
End If
Next
Range(EndBox).Select
Selection.Offset(1, -2).Select
I would like to work out how to get the final sum number to be read out automatically after the sum is calculated, however this loop is proving me trouble and I do not understand how I would implement this. Any help would be greatly appreciated.
n = 0
' Application.Speech.Speak (n)
You are setting n to 0 so you will always get 0.
Put that after Next to get the final value of n
For i = EndBox To 1 Step -1
If Cells(i, Col).Value <> "" Then
n = n + 1
Else
Cells(i, Col).Value = n
If Cells(i, Col).Offset(0, -2).Value = "NEW-BOX" Then Cells(i, Col).Interior.ColorIndex = 4
n = 0
End If
Next
Application.Speech.Speak (n)
Related
I want to create a program in VBA, that will change color of cell depending on the type. And if the value is negative, font will be bold.
My code:
Sub Tables()
Dim N As Integer
Dim M As Integer
Dim i As Integer
Dim j As Integer
M = InputBox("Number of columns")
N = InputBox("Number of rows")
For i = 0 To N
For j = 0 To M
If IsEmpty(Cells(i, j).Value) = True Then
Cells(i, j).Interior.ColorIndex = 0
ElseIf Application.WorksheetFunction.IsText(Cells(i, j).Value) = True Then
Cells(i, j).Interior.ColorIndex = 1
ElseIf Application.WorksheetFunction.IsLogical(Cells(i, j).Value) = True Then
Cells(i, j).Interior.ColorIndex = 2
ElseIf Application.WorksheetFunction.IsErr(Cells(i, j).Value) = True Then
Cells(i, j).Interior.ColorIndex = 3
ElseIf IsDate(Cells(i, j).Value) = True Then
Cells(i, j).Interior.ColorIndex = 4
ElseIf Cells(i, j).HasFormula = True Then
Cells(i, j).Interior.ColorIndex = 5
ElseIf IsNumeric(Cells(i, j).Value) = True Then
Cells(i, j).Interior.ColorIndex = 6
Else
Cells(i, j).Interior.ColorIndex = 7
End If
If Cells(i, j).Vallue < 0 Then
Cells(i, j).Font.Bold = True
End If
Next j
Next i
End Sub
Unfortunately, I got:
Error 1004 "Application-defined or Object-defined error
There is no row or column 0.
i and j should start at 1.
Also as already pointed out, If Cells(i, j).Value < 0 Then will fail if the cell contains an error value, and will also fail if the cell contains text. Make sure to check if it's a number first.
If IsNumeric(Cells(i, j).Value) Then
Or just move the "negative" logic earlier:
ElseIf IsNumeric(Cells(i, j).Value) = True Then
Cells(i, j).Interior.ColorIndex = 6
If Cells(i, j).Value < 0 Then
Cells(i, j).Font.Bold = True
End If
Else
I am not a VBA programmer and I need help.
In my spreadsheet my Location (ComboBox1) is text and I can not change it to be numeric. How do I fix it so it will use the Text. I guess I need to use the IsText function but I can not figure out how.
My code is pasted below. The first line after GetData() is where it stops.
Dim Loc As Integer, i As Integer, j As Integer, flag As Boolean
Sub GetData()
If IsNumeric(UserForm1.ComboBox1.Value) Then
flag = False
i = 0
id = UserForm1.ComboBox1.Value
Do While Cells(i + 1, 1).Value <> ""
If Cells(i + 1, 1).Value = id Then
flag = True
For j = 2 To 3
UserForm1.Controls("TextBox" & j).Value = Cells(i + 1, j).Value
Next j
End If
i = i + 1
Loop
If flag = False Then
For j = 2 To 3
UserForm1.Controls("TextBox" & j).Value = ""
Next j
End If
Else
ClearForm
End If
End Sub
Sub ClearForm()
For j = 1 To 3
UserForm1.Controls("TextBox" & j).Value = ""
Next j
End Sub
Sub EditAdd()
Dim emptyRow As Long
If UserForm1.ComboBox1.Value <> "" Then
flag = False
i = 0
id = UserForm1.ComboBox1.Value
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
Do While Cells(i + 1, 1).Value <> ""
If Cells(i + 1, 1).Value = id Then
flag = True
For j = 2 To 3
Cells(i + 1, j).Value = UserForm1.Controls("TextBox" & j).Value
Next j
End If
i = i + 1
Loop
If flag = False Then
For j = 1 To 3
Cells(emptyRow, j).Value = UserForm1.Controls("TextBox" & j).Value
Next j
End If
End If
End Sub
i had input like below
1 10
2 20
3 30
1 40
2 50
4 60
1 80
and output , if had multiple matches corresponding value should be like below.
1 10 40 80
2 20 50
3 30
4 60
A1:B7
1 10
2 20
3 30
1 40
2 50
4 60
1 80
Sub copyit()
Dim LastRow As Long
Dim myRange, MyRange1 As Range
LastRow = Cells(Rows.count, "A").End(xlUp).Row
For X = 1 To LastRow
For Y = 1 + X To LastRow
If Cells(X, 1).Value = Cells(Y, 1).Value Then
If MyRange1 Is Nothing Then
Set MyRange1 = Rows(Y).EntireRow
Rows(X).End(xlToRight).Offset(, 1).Value = Cells(Y, 2).Value
Else
Set MyRange1 = Union(MyRange1, Rows(Y).EntireRow)
Rows(X).End(xlToRight).Offset(, 1).Value = Cells(Y, 2).Value
End If
End If
Next
Next
MyRange1.Select
Selection.Delete
End Sub
OR . . .
Sub ConcatData()
Dim X As Double
Dim DataArray(5000, 2) As Variant
Dim NbrFound As Double
Dim Y As Double
Dim Found As Integer
Dim NewWks As Worksheet
Cells(1, 1).Select
Let X = ActiveCell.Row
Do While True
If Len(Cells(X, 1).Value) = Empty Then
Exit Do
End If
If NbrFound = 0 Then
NbrFound = 1
DataArray(1, 1) = Cells(X, 1)
DataArray(1, 2) = Cells(X, 2)
Else
For Y = 1 To NbrFound
Found = 0
If DataArray(Y, 1) = Cells(X, 1).Value Then
DataArray(Y, 2) = DataArray(Y, 2) & ", " & Cells(X, 2)
Found = 1
Exit For
End If
Next
If Found = 0 Then
NbrFound = NbrFound + 1
DataArray(NbrFound, 1) = Cells(X, 1).Value
DataArray(NbrFound, 2) = Cells(X, 2).Value
End If
End If
X = X + 1
Loop
Set NewWks = Worksheets.Add
NewWks.Name = "SummarizedData"
Cells(1, 1).Value = "Names"
Cells(1, 2).Value = "Results"
X = 2
For Y = 1 To NbrFound
Cells(X, 1).Value = DataArray(Y, 1)
Cells(X, 2).Value = DataArray(Y, 2)
X = X + 1
Next
Beep
MsgBox ("Summary is done!")
End Sub
what would be the best way to merge similar rows (only order number letter different a4;a6;a8 and produced quantity) and sum (produced quantity e4;e6;e8) cells? This is how excel table looks
Clarification:
Here is the output I'm looking for
Rows 4;6;8 are the same except Order column (one letter added on 6 and 8) and Produced Column (different produced quantity). Rows 4,6,8 are merged and produced quantity is summed. Rows 6,8 is hidden or deleted.
Here is an example that could solve your problem:
Sub test()
i = 1
produced = 0
While Cells(i, 1) <> "" Or Cells(i + 1, 1) <> ""
If Cells(i, 1) <> "" Then
produced = Cells(i, 5)
j = 1
'second loop to add up every line with the same order, then suppress the lines
While Cells(j, 1) <> "" Or Cells(j + 1, 1) <> ""
If Left(Cells(j, 1), 7) = Left(Cells(i, 1), 7) And i <> j Then
produced = produced + Cells(j, 5)
Cells(j, 5).EntireRow.Select
Selection.Delete Shift:=xlUp
j = j - 1
End If
j = j + 1
Wend
End If
i = i + 1
Wend
Ok, here is the modified #Bitoubi code which helped me:
Sub RemoveSplitOrders()
i = 1
produced = 0
While Cells(i, 1) <> "" Or Cells(i + 1, 1) <> ""
If Cells(i, 1) <> "" Then
produced = Cells(i, 20)
j = 1
'second loop to add up every line with the same order, then suppress the lines
While Cells(j, 1) <> "" Or Cells(j + 1, 1) <> ""
If Left(Cells(j, 1), 8) = Left(Cells(i, 1), 8) Or Left(Cells(j, 1), 9) = Left(Cells(i, 1), 9) Then
If Cells(j, 2) = Cells(i, 2) And i <> j Then
produced = produced + Cells(j, 20)
Cells(i, 20).Value = produced
Range(Cells(j, 20), Cells(j + 1, 20)).EntireRow.Delete Shift:=xlUp
j = j - 1
End If
End If
j = j + 1
Wend
End If
i = i + 1
Wend
End Sub
This code doesn't print -1 and 0 when it's supposed,
but everything else works fine.
It iterates through both lists: (Sheet1 and edi_partnere)
and exits loops when it's supposed.
Q: What am I missing: why isn't cells().value catching?
Do
If orgnr1 = "" Then Exit Sub
Do
orgnr2 = Sheets("edi_partnere").Cells(j, 1).Value
If orgnr2 = orgnr1 Then
Sheets("Sheet1").Cells(j, 9).Value = "-1" 'not happening
Exit Do
ElseIf orgnr2 = "" Then
Sheets("Sheet1").Cells(j, 9).Value = "0" 'not happening
Exit Do
Else: j = j + 1
End If
Loop
i = i + 1
orgnr1 = Sheets("Sheet1").Cells(i, 1).Value
Loop
I think that you must reset the variable j, so I add j = 0 in your code.
According to Siddharth Rout if orgnr1 not set then orgnr1 = Sheets("Sheet1").Cells(i, 1).Value
Do
If orgnr1 = "" Then Exit Sub
Do
orgnr2 = Sheets("edi_partnere").Cells(j, 1).Value
If orgnr2 = orgnr1 Then
Sheets("Sheet1").Cells(j, 9).Value = "-1" 'not happening
Exit Do
ElseIf orgnr2 = "" Then
Sheets("Sheet1").Cells(j, 9).Value = "0" 'not happening
Exit Do
Else: j = j + 1
End If
Loop
j = 0
i = i + 1
orgnr1 = Sheets("Sheet1").Cells(i, 1).Value
Loop