Hi I have created a workbook that uses formula to populate lists, one of which uses VBA to print labels.
My problem is the VBA sees the cell formula in blank cells and wants to print blank tags. How can I change it to see text only?
As I said, I need to edit my VBA to ignore formula and read only the resulting text.
VBA is below.
Sub Print_Labels()
Application.ScreenUpdating = False
Col_Width_1 = Range("Column_Width_1")
Col_Width_2 = Range("Column_Width_2")
Col_Width_3 = Range("Column_Width_3")
Col_Width_4 = Range("Column_Width_4")
Row_Height_1 = Range("Row_Height_1")
Row_Height_2 = Range("Row_Height_2")
Row_Height_3 = Range("Row_Height_3")
Row_Height_4 = Range("Row_Height_4")
Sheets("Equipment_List").Select
Num_Equip = Range("A1").CurrentRegion.Rows.Count
Start_Row = Range("Title_Label_Start_Row")
First_Page_YN = True
Names.Add "Equipment_List", "=" + Range("A1").Resize(Num_Equip).Address
Sheets("Labels").Select
' Set page setup
' Set column widths
For Count_Label_Columns = 1 To Num_Label_Columns
Range("A1").Offset(, (Count_Label_Columns - 1) *
4).EntireColumn.ColumnWidth = Col_Width_1
Range("B1").Offset(, (Count_Label_Columns - 1) *
4).EntireColumn.ColumnWidth = Col_Width_2
Range("C1").Offset(, (Count_Label_Columns - 1) *
4).EntireColumn.ColumnWidth = Col_Width_3
Range("D1").Offset(, (Count_Label_Columns - 1) *
4).EntireColumn.ColumnWidth = Col_Width_4
Next Count_Label_Columns
' Set row heights
For Count_Label_Rows = 1 To Num_Label_Rows
Range("A1").Offset((Count_Label_Rows - 1) * 4).EntireRow.RowHeight =
Row_Height_1
Range("A2").Offset((Count_Label_Rows - 1) * 4).EntireRow.RowHeight =
Row_Height_2
Range("A3").Offset((Count_Label_Rows - 1) * 4).EntireRow.RowHeight =
Row_Height_3
Range("A4").Offset((Count_Label_Rows - 1) * 4).EntireRow.RowHeight =
Row_Height_4
Next Count_Label_Rows
' Work out the first label row to be printed
If Start_Row > 10 Then Start_Row = 10
Count_Label_Rows = Start_Row
' Labels always start printing in the first column
Count_Label_Columns = 0
For Count_Equip = 1 To Num_Equip
' Start of new page of labels, so completely clear sheet
If First_Page_YN = True Then
Cells.Clear
First_Page_YN = False
End If
Count_Label_Columns = Count_Label_Columns + 1
If Count_Label_Columns > Num_Label_Columns Then
Count_Label_Columns = 1
Count_Label_Rows = Count_Label_Rows + 1
End If
If Count_Label_Rows > Num_Label_Rows Then
Count_Label_Rows = 1
Count_Label_Columns = 0
End If
If Count_Label_Rows = 1 And Count_Label_Columns = 0 Then
' Start of new page, so print full sheet
If Range("Title_Print_Preview") = "Print" Then
ActiveSheet.PrintOut
Else
ActiveSheet.PrintPreview
End If
Cells.Clear
Count_Label_Columns = 1
End If
Range("Title_Label_Format").Copy
Range("Labels_Top").Offset(((Count_Label_Rows - 1) * 4),
((Count_Label_Columns - 1) * 4) + 1).PasteSpecial
Range("Labels_Top").Offset(((Count_Label_Rows - 1) * 4) + 2,
((Count_Label_Columns - 1) * 4) + 2) = _
Range("Equipment_List").Offset(Count_Equip - 1).Resize(1, 1)
' Enter the sequence number of the equipment
Range("Labels_Top").Offset(((Count_Label_Rows - 1) * 4),
((Count_Label_Columns - 1) * 4) + 3) = Count_Equip
Next Count_Equip
' Print or Preview the last sheet
If Range("Title_Print_Preview") = "Print" Then
ActiveSheet.PrintOut
Else
ActiveSheet.PrintPreview
End If
Application.ScreenUpdating = True
End Sub
-------------------------------------------------------------------------------
Related
I'm trying to get number of unique ids with given values on given columns. I decided to use Scripting.Dictionary for this as follow:
Public Function getSoldToIrr(umowy As Range, bi As Range, irr As Range) As Double
Set dict = CreateObject("Scripting.Dictionary")
Dim lastRow As Long
lastRow = umowy.Rows.Count
bi_with = 0
irr_with = 0
ifff = 0 'count how many new values
elseifff = 0 'count how many duplicates
For i = 1 To lastRow
If umowy(i, 1) <> "" Then
If Not dict.Exists(umowy(i, 1)) Then ' if new id
dict(umowy(i, 1)) = Array(bi(i, 1), irr(i, 1) * bi(i, 1))
bi_with = bi_with + bi(i, 1)
irr_with = irr_with + irr(i, 1) * bi(i, 1) ' if bi and irr
ifff = ifff + 1
Else ' if found duplicate id
If dict(umowy(i, 1))(1) = 1 And bi(i, 1) = 1 Then ' if duplicate already had 1 on bi and now has bi
If dict(umowy(i, 1))(2) = 0 And irr(i, 1) = 1 Then ' if duplicate had 0 on irr but now has 1
irr_with = irr_with + irr(i, 1) * bi(i, 1)
dict(umowy(i, 1))(2) = 1
End If
ElseIf dict(umowy(i, 1))(1) = 0 And bi(i, 1) = 1 Then ' if bi was 0 and now is 1
dict(umowy(i, 1)) = Array(bi(i, 1), irr(i, 1) * bi(i, 1))
bi_with = bi_with + bi(i, 1)
irr_with = irr_with + irr(i, 1) * bi(i, 1)
End If
elseifff = elseifff + 1
End If
End If
Next i
MsgBox dict.Exists(umowy(1, 1).Value) ' returns False
MsgBox dict.Exists(dict.Keys()(0)) ' returns True
MsgBox umowy(1, 1) = dict.Keys()(0) ' returns True
MsgBox dict.Count ' returns 8000
MsgBox ifff ' returns 8000
MsgBox elseifff ' returns 0
getSoldToIrr = irr_with / bi_with
End Function
umowy is my id and those values are strings like 18/07/KOR/2020, bi and irr columns are binary columns. umowy has some duplicates but for some reason my dict takes duplicates as new keys and my code does not get into Else ' if found duplicate id.
Also if I write dict.Exists(umowy(1, 1).Value) or dict.Exists(umowy(1, 1)) I get False, but dict.Exists(dict.Keys()(0)) gives me True as umowy(1, 1) = dict.Keys()(0) and umowy(1, 1).Value = dict.Keys()(0)
What can be a reason of such behaviour?
My macro goes through all data rows on a specific sheet. Currently there are 6 rows. The first row is a negative number and the 2nd row is a positive number (debit and credit).
The macro reviews each row and displays a list box for the user to make a selection. Then it goes through the next row and does the same thing. I'm expecting the listbox to display 6 times, once for each row of data.
The problem I'm having is that the listbox is displaying 7 times. 3 times for the first pair or records and twice for the remaining pair of records. I can't figure out why the listbox is displaying the extra time.
Here is the code for the list box:
Private Sub ContinueButton_Click()
If IsNull(ListBox1.Value) Then
MsgBox " Please select the appropriate balance to continue. "
Exit Sub
Else
MyIndex = 0
MyIndex = ListBox1.ListIndex
MyIndex = MyIndex + 1
MyBal = ""
MyBal = APIARArray(MyIndex, 4)
Unload UserForm1
UserForm1.Hide
Sleep 750
End If
End Sub
Private Sub UserForm_Initialize()
UserForm1.Label1.Caption = "Please select the appropriate balance for Unit: " & vUnit
ListBox1.ColumnCount = 4
ListBox1.ColumnWidths = "50;50;75;50"
Dim i As Integer
With ListBox1
w = 1
i = 0
For w = 1 To UBound(APIARArray)
DoEvents
.AddItem
.List(i, 0) = APIARArray(w, 1)
.List(i, 1) = APIARArray(w, 2)
.List(i, 2) = APIARArray(w, 3)
.List(i, 3) = format(APIARArray(w, 4), "#,##0.00;[Red](#,##0.00)")
i = i + 1
Next
End With
UserForm1.Height = 215
UserForm1.Width = 348
ListBox1.SetFocus
End Sub
This is the code that calls the ListBox:
Sub LookForBalance()
Dim r As Integer
Dim APIUnit As String
r = 2
Do Until Len(Trim(Cells(r, 1))) + Len(Trim(Cells(r, 7))) + Len(Trim(Cells(r, 9))) + Len(Trim(Cells(r, 10))) + Len(Trim(Cells(r, 11))) = 0
DoEvents
If Trim(Cells(r, 27)) = "A199" Then
If Cells(r, 29) > 90 Then
APIUnit = ""
vUnit = ""
vUnit = Trim(Cells(r, 11))
If MyCntry = "A1" Then APIUnit = clsAPI.APIARSearch("WWW11", Trim(Cells(r, 11)))
If MyCntry = "A2" Then APIUnit = clsAPI.APIARSearch("WWW12", Trim(Cells(r, 11)))
If InStr(1, APIUnit, "ERROR") > 0 Then
Cells(r, 30) = "Unit Not Found"
Else
If UBound(APIARArray) > 1 Then
Load UserForm1
UserForm1.Show
Cells(r, 30) = MyBal
Else
Cells(r, 30) = APIARArray(1, 4)
End If
End If
End If
End If
r = r + 1
Loop
End Sub
There isn't much code here but I'm not sure what is going on. Any help or suggestions to resolve this issue would be greatly appreciated. Thanks in advance for your help.....
I have an excel table where there are part codes in a column and for every part code, there are 3-4 subsections (1100-1400) with information which I need to attach to the part code in a column view.
The number of created rows depends on if there is data entered into subsection 1400. 1100-1300 has always information and needs to be converted into a table.
I don't even know from where to start so currently I have no code to show
I added a picture of how the data is represented and what the result should look like:
You could do it like that
Option Explicit
Sub TransformA()
Dim rg As Range
Dim lastRow As Long, lineNo As Long, i As Long, j As Long
Dim shInput As Worksheet, shResult As Worksheet
Dim vDat As Variant, resDat As Variant
Dim subSection As String
' Make sure you run the code with the data in the Activesheet
Set shInput = ActiveSheet
' And you have data which starts in row 4 with the heading in row 3
' otherwise adjust accordingly
lastRow = shInput.Range("A4").End(xlDown).Row
Set rg = shInput.Range("A4:I" & lastRow)
vDat = rg
ReDim resDat(1 To UBound(vDat, 1) * 4, 1 To 4)
lineNo = 1
For j = 1 To UBound(vDat, 1)
For i = 0 To 2
Select Case i
Case 0: subSection = "1100"
Case 1: subSection = "1200"
Case 2: subSection = "1300"
End Select
resDat(lineNo + i, 1) = vDat(j, 1)
resDat(lineNo + i, 2) = subSection
resDat(lineNo + i, 3) = vDat(j, 2 + 2 * i)
resDat(lineNo + i, 4) = vDat(j, 3 + 2 * i)
Next
i = 3
subSection = "1400"
If Len(vDat(j, 2 + 2 * i)) = 0 And Len(vDat(j, 3 + 2 * i)) = 0 Then
lineNo = lineNo + 3
Else
resDat(lineNo + i, 1) = vDat(j, 1)
resDat(lineNo + i, 2) = subSection
resDat(lineNo + i, 3) = vDat(j, 2 + 2 * i)
resDat(lineNo + i, 4) = vDat(j, 3 + 2 * i)
lineNo = lineNo + 4
End If
Next
' Output the result to a new sheet
Set shResult = Sheets.Add
With shResult
.Cells(1, 1).Value = "Part Code"
.Cells(1, 2).Value = "Subsection"
.Cells(1, 3).Value = "Time"
.Cells(1, 4).Value = "Text"
End With
shResult.Range("A2").Resize(UBound(resDat, 1), 4) = resDat
End Sub
Hello I have three columns with filled with names. So far I need to extract the three first cells of each column and put all the 15 names into a forth column. But if there are duplicates I must not put them in the list.
So far I got into
Private Sub CommandButton1_Click()
Dim temp(15) As String
Dim array1(5) As String
Dim array2(5) As String
Dim array3(5) As String
Dim i As Integer
Dim j As Integer
For i = 1 To 5
array1(i) = Cells(i + 3, 1).Value
array2(i) = Cells(i + 3, 4).Value
array3(i) = Cells(i + 3, 7).Value
Next i
temp(1) = array1(1)
temp(2) = array1(2)
temp(3) = array1(3)
temp(4) = array1(4)
temp(5) = array1(5)
temp(6) = array2(1)
temp(7) = array2(2)
temp(8) = array2(3)
temp(9) = array2(4)
temp(10) = array2(5)
temp(11) = array3(1)
temp(12) = array3(2)
temp(13) = array3(3)
temp(14) = array3(4)
temp(15) = array3(5)
For i = 1 To 15
For j = 1 To 15
If (temp(i) = temp(j + 1)) Then
Else
Cells(i + 4, 10).Value = temp(i)
End If
Next j
j = 0
Next i
End Sub
For i = 1 to 3
Cells(6 * i - 5, 10).Resize(5, 1).Value = Cells(6 * i - 5, 4 * i - 3).Resize(5,1).Value
Next
Application.DisplayAlerts = False
Cells(1, 10).Resize(15, 1).RemoveDuplicates Columns:=1, Header:=xlNo
Application.DisplayAlerts = True
I'm new to programming, and VBA, and seem to be a bit stuck with a piece of code I have written. I understand that I need to put in a next inbetween the two Fors on my code, I'm just not sure where and what should follow.
Please help!! Here's my code if anyone can help me!
Sub Order()
rowdata = 1
Do While Cells(rowdata, 1) <> ""
rowdata = rowdata + 1
Loop
dataend = rowdata - 1
rowwrite = rowdata + 2
Cells(rowwrite, 1) = "Item Code"
For col = 1 To 3
Cells(rowwrite, col) = Cells(1, col)
Next col
rowwrite = rowwrite + 1
target = Cells(2, 7)
**For** rowdata = 2 To dataend
If Cells(rowdata, 1) = target Then
Cells(rowdata, 5) = Cells(rowdata, 5) - 1
End If
If Cells(rowdata, 5) = Cells(rowdata, 4) Then
**For** col = 1 To 3
Cells(rowwrite, col) = Cells(rowdata, col)
Next col
rowwrite = rowwrite + 1
End If
End sub
Thanks in advance!
**For** rowdata = 2 To dataend
If Cells(rowdata, 1) = target Then
Cells(rowdata, 5) = Cells(rowdata, 5) - 1
End If
If Cells(rowdata, 5) = Cells(rowdata, 4) Then
**For** col = 1 To 3
Cells(rowwrite, col) = Cells(rowdata, col)
Next col
rowwrite = rowwrite + 1
End If
Next rowData
I've reformatted your indents to a more standard method. There are two places you can put your "Next" statement it just depends on the logic you need. I've put in in between loops but if you can nest the loops (one inside the other) if that is what you need logically.
Sub Order()
rowdata = 1
Do While Cells(rowdata, 1) <> ""
rowdata = rowdata + 1
Loop
dataend = rowdata - 1
rowwrite = rowdata + 2
Cells(rowwrite, 1) = "Item Code"
For col = 1 To 3
Cells(rowwrite, col) = Cells(1, col)
Next col
rowwrite = rowwrite + 1
target = Cells(2, 7)
For rowdata = 2 To dataend 'your ** line
If Cells(rowdata, 1) = target Then
Cells(rowdata, 5) = Cells(rowdata, 5) - 1
End If
Next 'new Next
If Cells(rowdata, 5) = Cells(rowdata, 4) Then
For col = 1 To 3
Cells(rowwrite, col) = Cells(rowdata, col)
Next col
rowwrite = rowwrite + 1
End If
End Sub