Excel VBA to multiply cell if another cell contains text [closed] - excel

Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 6 years ago.
Improve this question
I do know the formula but not sure how to translate into VBA.
Need a VBA script to do the following.
If cell D contains Debit, then value in F multiply -1
If cell D contains Credit, then value in F multiply 1
Loop until last row.

Use this macro:
Sub subMultiply()
For Each cel In Range("D1:D" & Range("D1").End(xlDown).Row)
If cel.Value = "Debit" Then
cel.Offset(0, 2).Value = Val(cel.Offset(0, 2)) * (-1)
ElseIf cel.Value = "Credit" Then
cel.Offset(0, 2).Value = Val(cel.Offset(0, 2)) * 1
End If
Next
End Sub

Related

Excel Display Zeros in Number Without Error [closed]

Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 3 years ago.
Improve this question
In excel VBA how do I display the following numbers as they appear without generating the 'Number stored as text' error in the cell?
1.0
1.1
1.2
.
.
1.99
1.100
1.101
1.102
.
.
1.20
1.21
1.22
.
.
etc...
Just keep track of the number of decimal places that need to be displayed. For example:
Sub marine()
Dim s As String, i As Long, a
s = "1.0,1.1,1.2,1.99,1.100,1.101,1.102,1.20,1.21,1.22"
arr = Split(s, ",")
i = 1
For Each a In arr
With Cells(i, 1)
.Value = a
brr = Split(a, ".")
.NumberFormat = "0." & Application.Rept("0", Len(brr(1)))
End With
i = i + 1
Next a
End Sub
This is based on the curious fact that if VBA puts a number-like string into a cell, Excel will convert it into a number:
Sub demo()
Dim s As String
s = "1.230"
Range("A1").Value = s
End Sub
EDIT#1:
On the other hand, if you want to enter text that look like numbers, but avoid raising the error flag, then:
Sub Macro1()
Application.ErrorCheckingOptions.NumberAsText = False
End Sub

Extract normal font to new cell [closed]

Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 4 years ago.
Improve this question
I have multiple cells with bold font and normal font, I am looking to only extract the font that isn't bold to a new cell. Does anyone know how I can do this?
Thanks
You can just do the reverse of what Siddarth was doing in the post I linked - for example:
Using this:
Sub Test()
Dim mystring As String
For i = 1 To Len(Range("A1").Value)
If Range("A1").Characters(i, 1).Font.FontStyle = "Regular" Then
mystring = mystring & Mid(Range("A1").Value, i, 1)
ElseIf Len(mystring) > 0 Then
Debug.Print Trim(mystring)
mystring = ""
End If
If i = Len(Range("A1").Value) Then
Debug.Print Trim(mystring)
End If
Next i
End Sub
Returns:

Auto fill macro [closed]

Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 4 years ago.
Improve this question
I have a task to create a loop that fills in columns with the following data:
Column A should populate with a number from 1 to 10000,
Column B should populate with a today's date and increment with the number,
Column C should populate with number of a day of the week so repeating from 1 to 7 every week,
Column D should populate with a day of the week from Monday to Sunday (text).
I think this could be achieved with a For ...Next loop. More complicated would be with the dates...
Could you please give me a hint how to go about this?
THank you
try this
Sub mm()
Dim i As Long
Dim weekDayNames As Variant
With Range("A1:A10000")
.Formula = "=ROW()"
.Offset(, 1).FormulaR1C1 = "=Today()+RC1-1"
.Offset(, 2).FormulaR1C1 = "=WEEKDAY(RC2,1)"
With .Offset(, 1).Resize(, 2)
.Value = .Value
End With
weekDayNames = Application.Transpose(.Offset(, 2).Value)
For i = 1 To UBound(weekDayNames)
weekDayNames(i) = WeekdayName(weekDayNames(i), False, vbSunday)
Next
.Offset(, 3).Value = Application.Transpose(weekDayNames)
End With
End Sub

Overflow error in vba code in addition [closed]

Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 5 years ago.
Improve this question
I am new in VBA, please help me to resolve below.
While running below facing OVERFLOW error:
total = 0
employee = InputBox("Enter the employee Name")
For Each sheet In Worksheets
For i = 2 To 13
If sheet.Cells(i, 2).Value = employee Then
total = sheet.Cells(i, 3).Value + total
End If
Next i
Next sheet
You are potentially overflowing the total variable as it's probably defaulting to an INTEGER for storage which can only hold up to two bytes (-32768 to 32767).
Instead declare your variable with a type that can hold more data:
Dim total as Long
total = 0
employee = InputBox("ENter the employee Name")
For Each sheet In Worksheets
For i = 2 To 13
If sheet.Cells(i, 2).Value = employee Then
total = sheet.Cells(i, 3).Value + total
End If
Next i
Next sheet

EXCEL VBA Speed up my code [closed]

Closed. This question is off-topic. It is not currently accepting answers.
Want to improve this question? Update the question so it's on-topic for Stack Overflow.
Closed 10 years ago.
Improve this question
As per title, the codes below are located in my Private Sub Workbook_open(). Therefore every time I open my workbook it is slow. How do I get to optimize the code to run fastest? Any help is appreciated.
'Sheets("Summary(FG)") ComboBox1 items
For b = 3 To Sheets("CustomerList").Cells(3, 2).SpecialCells(xlLastCell).row
If Sheets("CustomerList").Cells(b, 2) <> "" Then
Worksheets("Summary(FG)").ComboBox1.AddItem (Sheets("CustomerList").Cells(b, 2))
Else
End If
Next
'Sheets("Summary(RawMat)") ComboBox1 items
For a = 2 To Sheets("RawMatList").Cells(2, 2).SpecialCells(xlLastCell).Column
If Sheets("RawMatList").Cells(2, a) <> "" Then
Worksheets("Summary(RawMat)").ComboBox1.AddItem (Sheets("RawMatList").Cells(2, a))
End If
Next
'sheets("Summary(WIP)") ComboBox1 items
For c = 3 To Sheets("WIPList").Cells(3, 2).SpecialCells(xlLastCell).row
If Sheets("WIPList").Cells(c, 2) <> "" Then
Worksheets("Summary(WIP)").ComboBox1.AddItem (Sheets("WIPList").Cells(c, 2))
End If
Next
For Each Worksheet In Worksheets
Application.Goto Reference:=Range("A1"), Scroll:=True
Next Worksheet
It looks like your loop is iterating through every row or every column on a worksheet. Instead of using the last row or last column try using the last used row or last used column. This way instead of moving through thousands of blank rows you only check rows containing data.
Try:
'Sheets("Summary(FG)") ComboBox1 items
For b = 3 To Sheets("CustomerList").UsedRange.Rows.Count
If Sheets("CustomerList").Cells(b, 2) <> "" Then
Worksheets("Summary(FG)").ComboBox1.AddItem (Sheets("CustomerList").Cells(b, 2))
Else
End If
Next
'Sheets("Summary(RawMat)") ComboBox1 items
For a = 2 To Sheets("RawMatList").UsedRange.Columns.Count
If Sheets("RawMatList").Cells(2, a) <> "" Then
Worksheets("Summary(RawMat)").ComboBox1.AddItem (Sheets("RawMatList").Cells(2, a))
End If
Next
'sheets("Summary(WIP)") ComboBox1 items
For c = 3 To Sheets("WIPList").UsedRange.Rows.Count
If Sheets("WIPList").Cells(c, 2) <> "" Then
Worksheets("Summary(WIP)").ComboBox1.AddItem (Sheets("WIPList").Cells(c, 2))
End If
Next
For Each Worksheet In Worksheets
Application.Goto Reference:=Range("A1"), Scroll:=True
Next Worksheet

Resources