Everything seems to work except placing string in cells - excel

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

Related

Code Refactoring, Moving cells from one sheet to another

I am trying to refactor a part of a project that I am working on I have Two blocks of code that pretty much do the same thing except with a single variable changed (rowNum_partNum, 1) and (rowNum, 2) in the other block. I can not split the two into separate functions as they both use a variable that is highly manipulated within the current function. I tried refactoring but I cant figure out what's wrong.
Original Code that works:
If PartNumber_Category_Selector() <> 0 Then
If PartNumber_Category_Selector() = 1 Then
Dim rowNum_partNum As Long
Dim searchRow_PartNum As Long
rowNum_partNum = 9
searchRow_PartNum = 9
Worksheets("DataBase").Activate
Do Until Cells(rowNum_partNum, 1).Value = ""
If InStr(1, Cells(rowNum_partNum, 1).Value, searchingItem, vbTextCompare) > 0 Then
Worksheets("LeadTimes").Cells(searchRow_PartNum, 1).Value = Cells(rowNum_partNum, 1).Value
Worksheets("LeadTimes").Cells(searchRow_PartNum, 2).Value = Cells(rowNum_partNum, 2).Value
Worksheets("LeadTimes").Cells(searchRow_PartNum, 3).Value = Cells(rowNum_partNum, 3).Value
Worksheets("LeadTimes").Cells(searchRow_PartNum, 4).Value = Cells(rowNum_partNum, 4).Value
searchRow_PartNum = searchRow_PartNum + 1
End If
rowNum_partNum = rowNum_partNum + 1
Loop
If searchRow_PartNum = 9 Then
MsgBox "No Results found"
Else
lst_leadTime.RowSource = "SearchResultsV5"
End If
ElseIf PartNumber_Category_Selector() = 2 Then
Dim rowNum As Long
Dim searchRow As Long
rowNum = 9
searchRow = 9
Worksheets("DataBase").Activate
Do Until Cells(rowNum, 1).Value = ""
If InStr(1, Cells(rowNum, 2).Value, searchingItem, vbTextCompare) > 0 Then
Worksheets("LeadTimes").Cells(searchRow, 1).Value = Cells(rowNum, 1).Value
Worksheets("LeadTimes").Cells(searchRow, 2).Value = Cells(rowNum, 2).Value
Worksheets("LeadTimes").Cells(searchRow, 3).Value = Cells(rowNum, 3).Value
Worksheets("LeadTimes").Cells(searchRow, 4).Value = Cells(rowNum, 4).Value
searchRow = searchRow + 1
End If
rowNum = rowNum + 1
Loop
If searchRow = 9 Then
MsgBox "No Results found "
Else
lst_leadTime.RowSource = "SearchResultsV5"
End If
Else
MsgBox "No Results found "
End If
Else
MsgBox "No Results found "
End If
Refactored code (Does not work):
If PartNumber_Category_Selector() <> 0 Then
Dim rowNum_partNum As Long, searchRow_PartNum As Long, Selector As Byte
rowNum_partNum = 9
searchRow_PartNum = 9
Selector = PartNumber_Category_Selector()
Worksheets("DataBase").Activate
Do Until Cells(rowNum_partNum, Selector).Value = ""
If InStr(1, Cells(rowNum_partNum, Selector).Value, searchingItem, vbTextCompare) > 0 Then
Worksheets("LeadTimes").Cells(searchRow_PartNum, 1).Value = Cells(rowNum_partNum, 1).Value
Worksheets("LeadTimes").Cells(searchRow_PartNum, 2).Value = Cells(rowNum_partNum, 2).Value
Worksheets("LeadTimes").Cells(searchRow_PartNum, 3).Value = Cells(rowNum_partNum, 3).Value
Worksheets("LeadTimes").Cells(searchRow_PartNum, 4).Value = Cells(rowNum_partNum, 4).Value
searchRow_PartNum = searchRow_PartNum + 1
End If
rowNum_partNum = rowNum_partNum + 1
Loop
If searchRow = 9 Then
MsgBox "No Results found "
Else
lst_leadTime.RowSource = "SearchResultsV5"
End If
End IF

Getting "Run error time '13': Type Mismatch on "DIV/0" value in cell

I am getting Run error time '13': Type Mismatch on "#DIV/0 value in cell that I have tried to address with my code not to reach this point but the vba skips implementing the first if condition (unloading the userform and exiting this condition) and results in this error over and over again.
The highlighted line in the code for debug is If ws.Cells(iRow, 32) = True Then.
When the value in the cells are #DIV/0, it is normal to get this error but I tried to check beforehand and get out of the condition if this occurs.
The code goes as follows:
If ws.Cells(45, 7) = 1 Then
Dim msg1, button1, title1, response1
msg1 = "Are you sure you don't want to check any of the presented questions? In this case, Contractual factors category will be removed from the evaluation process and the weights will be reallocated."
button1 = vbYesNo + vbDefaultButton2
title1 = "Confirmation Notice"
response1 = MsgBox(msg1, button1, title1)
If response1 = vbYes Then
If ws.Cells(53, 6).Value = 1 Then
MsgBox "No single factor was selected. Thus, there are no results to be evaluated."
Unload Me
Call clear_data
Dashboard.Show
Else
iRow2 = 2
For iRow = 2 To 7
**If ws.Cells(iRow, 32) = True Then**
ws.Cells(iRow2, 38).Value = ws.Cells(iRow, 27)
ws.Cells(iRow2, 39).Value = ws.Cells(iRow, 31)
iRow2 = iRow2 + 1
End If
Next iRow
Unload Me
conf.Show
End If
Else
Exit Sub
End If
Else
iRow2 = 45
For iRow = 45 To 51
If ws.Cells(iRow, 6) = True Then
ws.Cells(iRow2, 9).Value = ws.Cells(iRow, 3)
ws.Cells(iRow2, 10).Value = ws.Cells(iRow, 4)
iRow2 = iRow2 + 1
End If
Next iRow
End If
If ws.Cells(8, 32).Text = "#DIV/0!" Then
Unload Me
Dashboard.Show
ElseIf ws.Cells(8, 32) = 1 Then
iRow2 = 2
For iRow = 2 To 7
If ws.Cells(iRow, 32) = True Then
ws.Cells(iRow2, 38).Value = ws.Cells(iRow, 27)
ws.Cells(iRow2, 39).Value = ws.Cells(iRow, 31)
iRow2 = iRow2 + 1
End If
Next iRow
Unload Me
conf.Show
Else
iRow2 = 2
For iRow = 2 To 7
If ws.Cells(iRow, 32) = True Then
ws.Cells(iRow2, 38).Value = ws.Cells(iRow, 27)
ws.Cells(iRow2, 39).Value = ws.Cells(iRow, 31)
ws.Cells(iRow2, 41).Value = ws.Cells(iRow, 31)
iRow2 = iRow2 + 1
End If
Next iRow
Unload Me
CPIGauge.Show
End If
I would appreciate any help regarding this error.
Try not to check for the error:
If ws.Cells(8, 32).Text = "#DIV/0!" Then
Try to prevent it:
If ws.Cells(1, 3).Value = 0 Then 'Do something to handle the zero before the division.

Else without If error after a bunch of ElseIf statements

I'm getting an Else without If error after all my ElseIf statements. I'm trying to end my initial If AColValue = "LV Fuses" with an Else statement but it's giving me this error at the Else.
Do While j <> 1
If AColValue = "LV Fuses" Then 'Fuse info starts with a row labelled "LV Fuses" in Col A
j = 1
Exit Do
ElseIf AColValue = "HV/MV with Trip-Unit" Then '
j = 1
Exit Do
ElseIf AColValue = "HV/MV without Trip-Unit" Then '
j = 1
Exit Do
ElseIf AColValue = "Relays" Then '
j = 1
Exit Do
ElseIf AColValue = "MCP" Then '
j = 1
Exit Do
ElseIf AColValue = "MOL" Then '
j = 1
Exit Do
ElseIf AColValue = "HV Fuses" Then '
j = 1
Exit Do
ElseIf AColValue = "Switches" Then '
j = 1
Exit Do
ElseIf AColValue = "" Then '
NumOfBkrs = NumOfBkrs + 1
RowNumberPlus1 = RowNumber + 1
AColValue = Range("A" & RowNumberPlus1)
If AColValue = "" Then
RowNumberPlus1 = RowNumberPlus1 + 1
AColValue = Range("A" & RowNumberPlus1)
If AColValue = "" Then
j = 1
End If
End If
End If
Else
RowNumber = RowNumber + 1
End If
AColValue = Range("A" & RowNumber)
Loop
Your second to last End If closes the main If.
Then, the following Else has no If.

I am getting a error because my value is Text and it is looking for a Numeric Value how do I fix this?

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

Implementing voice synthesis into this loop

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)

Resources