'copies all data on the userform to their respective places in Sheet7 which is the database.
With Sheet7
For t = 1 To 7
On Error Resume Next
If Me.Controls("Subcat" & t).Value <> "" Or Me.Controls("Period" & t).Value <> "" Then
.Range("B" & Rows.count).End(xlUp).Offset(1, 0) = Concept.Value
.Range("C" & Rows.count).End(xlUp).Offset(1, 0) = Objective.Value
.Range("D" & Rows.count).End(xlUp).Offset(1, 0) = Trade.Value
.Range("E" & Rows.count).End(xlUp).Offset(1, 0) = Application.WorksheetFunction.VLookup(Objective.Value, Sheet8.Range("B:H"), 7, False)
.Range("F" & Rows.count).End(xlUp).Offset(1, 0) = DateFrom.Value
.Range("G" & Rows.count).End(xlUp).Offset(1, 0) = DateTo.Value
.Range("H" & Rows.count).End(xlUp).Offset(1, 0) = LeBud.Value
.Range("I" & Rows.count).End(xlUp).Offset(1, 0) = TypeCB.Value
Dim RE As Control
For Each RE In Me.RetailF.Controls
If RE = True Then
If RE.Caption <> "Distribuidoras" Then
If TypeName(RE) <> "CheckBox" Then
.Range("J" & Rows.count).End(xlUp).Offset(1, 0) = RE.Caption
End If
End If
End If
Next RE
Dim COL, WHI, MS As String
For Each RE In Me.RetailF.Controls
If TypeName(RE) = "CheckBox" Then
If RE.Caption = "Colmados" And RE = True Then
COL = "/COL"
End If
If RE.Caption = "Minisupers" And RE = True Then
MS = "/MS"
End If
If RE.Caption = "Mayoristas Indirectos" And RE = True Then
WHI = "/WHI"
End If
End If
Next RE
If DistribsOB = True Then
.Range("J" & Rows.count).End(xlUp).Offset(1, 0) = "Distrib." & COL & MS & WHI
End If
If MultiPage1.Visible = True Then
.Range("K" & Rows.count).End(xlUp).Offset(1, 0) = Me.Controls("Subcat" & t).Value & " - " & Me.Controls("SKU" & t).Value
.Range("L" & Rows.count).End(xlUp).Offset(1, 0) = Me.Controls("Qty" & t).Value
.Range("N" & Rows.count).End(xlUp).Offset(1, 0) = Me.Controls("Disc" & t).Value
.Range("O" & Rows.count).End(xlUp).Offset(1, 0) = Me.Controls("Price" & t).Value
.Range("M" & Rows.count).End(xlUp).Offset(1, 0) = UnitsMeasure.Value
.Range("Q" & Rows.count).End(xlUp).Offset(1, 0) = Me.Controls("Amnt" & t).Value
End If
If MultiPage2.Visible = True Then
.Range("K" & Rows.count).End(xlUp).Offset(1, 0) = Me.Controls("Period" & t).Value
If AmntOpt = True Then
.Range("Q" & Rows.count).End(xlUp).Offset(1, 0) = Me.Controls("Prct" & t).Value
Else
.Range("Q" & Rows.count).End(xlUp).Offset(1, 0) = Me.Controls("mpAmnt" & t).Value
End If
End If
.Range("R" & Rows.count).End(xlUp).Offset(1, 0).Hyperlinks.Add anchor:=.Range("R" & Rows.count).End(xlUp).Offset(1, 0), Address:=Doc1.Value, TextToDisplay:=GetFileName(Doc1.Value)
.Range("S" & Rows.count).End(xlUp).Offset(1, 0).Hyperlinks.Add anchor:=.Range("S" & Rows.count).End(xlUp).Offset(1, 0), Address:=Doc2.Value, TextToDisplay:=GetFileName(Doc2.Value)
.Range("T" & Rows.count).End(xlUp).Offset(1, 0).Hyperlinks.Add anchor:=.Range("T" & Rows.count).End(xlUp).Offset(1, 0), Address:=Doc3.Value, TextToDisplay:=GetFileName(Doc3.Value)
.Range("U" & Rows.count).End(xlUp).Offset(1, 0) = Environ("UserName")
.Range("V" & Rows.count).End(xlUp).Offset(1, 0) = Date
If AddComment.Enabled = True Then
.Range("W" & Rows.count).End(xlUp).Offset(1, 0) = AddComment.Value
ElseIf AddComment.Enabled = False Then
Dim lItem As Long
g = ""
For lItem = 0 To SpecificClients.ListCount - 1
If SpecificClients.Selected(lItem) = True Then
g = g & "/" & SpecificClients.List(lItem)
End If
Next
.Range("X" & Rows.count).End(xlUp).Offset(1, 0) = g
End If
.Range("A" & Rows.count).End(xlUp).Offset(1, 0) = reqnum
End If
Next
End With
'when the files upload and changes to the database is done, show the userform again and terminate the patience message, UserForm3.
Unload UserForm3
GTNForm.Show False
'add all userform data to the printable form.
With Sheet3
For t = 1 To 7
On Error Resume Next
If Me.Controls("Subcat" & t).Value <> "" Or Me.Controls("Period" & t).Value <> "" Then
.Range("B" & Rows.count).End(xlUp).Offset(1, 0) = Concept.Value
.Range("C" & Rows.count).End(xlUp).Offset(1, 0) = Objective.Value
.Range("E" & Rows.count).End(xlUp).Offset(1, 0) = Trade.Value
.Range("D" & Rows.count).End(xlUp).Offset(1, 0) = Application.WorksheetFunction.VLookup(Objective.Value, Sheet8.Range("B:H"), 7, False)
.Range("F" & Rows.count).End(xlUp).Offset(1, 0) = DateFrom.Value
.Range("G" & Rows.count).End(xlUp).Offset(1, 0) = DateTo.Value
.Range("H" & Rows.count).End(xlUp).Offset(1, 0) = LeBud.Value
.Range("I" & Rows.count).End(xlUp).Offset(1, 0) = TypeCB.Value
Dim fRE As Control
For Each fRE In Me.RetailF.Controls
If fRE = True Then
If fRE.Caption <> "Distribuidoras" Then
If TypeName(fRE) <> "CheckBox" Then
.Range("J" & Rows.count).End(xlUp).Offset(1, 0) = fRE.Caption
End If
End If
End If
Next fRE
For Each fRE In Me.RetailF.Controls
If TypeName(fRE) = "CheckBox" Then
If fRE.Caption = "Colmados" And fRE = True Then
COL = "/COL"
End If
If fRE.Caption = "Minisupers" And fRE = True Then
MS = "/MS"
End If
If fRE.Caption = "Mayoristas Indirectos" And fRE = True Then
WHI = "/WHI"
End If
End If
Next fRE
If DistribsOB = True Then
.Range("J" & Rows.count).End(xlUp).Offset(1, 0) = "Distrib." & COL & MS & WHI
End If
If MultiPage1.Visible = True Then
.Range("K" & Rows.count).End(xlUp).Offset(1, 0) = Me.Controls("Subcat" & t).Value
.Range("L" & Rows.count).End(xlUp).Offset(1, 0) = Me.Controls("Amnt" & t).Value
.Range("M" & Rows.count).End(xlUp).Offset(1, 0) = TAmnt.Value
End If
If MultiPage2.Visible = True Then
.Range("K" & Rows.count).End(xlUp).Offset(1, 0) = Me.Controls("Period" & t).Value
If AmntOpt = True Then
.Range("L" & Rows.count).End(xlUp).Offset(1, 0) = Me.Controls("mpAmnt" & t).Value
.Range("M" & Rows.count).End(xlUp).Offset(1, 0) = TAmnt.Value
Else
.Range("L" & Rows.count).End(xlUp).Offset(1, 0) = Me.Controls("Prct" & t).Value
End If
End If
.Range("S" & Rows.count).End(xlUp).Offset(1, 0).Hyperlinks.Add anchor:=.Range("S" & Rows.count).End(xlUp).Offset(1, 0), Address:=Doc2.Value, TextToDisplay:=GetFileName(Doc2.Value)
.Range("T" & Rows.count).End(xlUp).Offset(1, 0).Hyperlinks.Add anchor:=.Range("T" & Rows.count).End(xlUp).Offset(1, 0), Address:=Doc3.Value, TextToDisplay:=GetFileName(Doc3.Value)
If AddComment.Enabled = True Then
.Range("N" & Rows.count).End(xlUp).Offset(1, 0) = AddComment.Value
ElseIf AddComment.Enabled = False Then
h = ""
For lItem = 0 To SpecificClients.ListCount - 1
If SpecificClients.Selected(lItem) = True Then
h = h & "/" & SpecificClients.List(lItem)
End If
Next
.Range("N" & Rows.count).End(xlUp).Offset(1, 0) = h
End If
.Range("A" & Rows.count).End(xlUp).Offset(1, 0) = reqnum
End If
Next
End With
Dim k As Long, count As Long
Dim Rng As Range
Application.DisplayAlerts = False
With Sheet3
Set Rng = .Range("A4:A44")
For k = 4 To 40
If .Range("A" & k) = .Range("A" & k).Offset(1, 0) And .Range("A" & k) <> "" Then
count = WorksheetFunction.CountIf(Rng, .Range("A" & k))
.Range("A" & k & ":" & "A" & k + count - 1).Merge
.Range("N" & k & ":" & "N" & k + count - 1).Merge
.Range("B" & k & ":" & "B" & k + count - 1).Merge
.Range("C" & k & ":" & "C" & k + count - 1).Merge
.Range("D" & k & ":" & "D" & k + count - 1).Merge
.Range("E" & k & ":" & "E" & k + count - 1).Merge
.Range("F" & k & ":" & "F" & k + count - 1).Merge
.Range("G" & k & ":" & "G" & k + count - 1).Merge
.Range("H" & k & ":" & "H" & k + count - 1).Merge
.Range("I" & k & ":" & "I" & k + count - 1).Merge
.Range("J" & k & ":" & "J" & k + count - 1).Merge
.Range("M" & k & ":" & "M" & k + count - 1).Merge
k = i + count - 1
End If
Next
End With
Application.DisplayAlerts = True
For Each usedcell In Sheet3.Range("A4:N44")
If usedcell <> "" Then
With Sheet3.Range("A" & usedcell.Row & ":" & "N" & usedcell.Row).Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Sheet3.Range("A" & usedcell.Row).HorizontalAlignment = xlCenter
Sheet3.Range("M" & usedcell.Row).HorizontalAlignment = xlCenter
Sheet3.Range("H" & usedcell.Row).HorizontalAlignment = xlCenter
Sheet3.Range("E" & usedcell.Row).HorizontalAlignment = xlCenter
End If
Next usedcell
Sheet4.Range("A7") = Environ("UserName")
Sheet4.Range("A9") = "Fecha: " & Date
If Sheet3.Shapes.count >= 0 Then
Sheet3.DrawingObjects.Delete
End If
Application.CutCopyMode = True
Sheet4.Range("A1:J18").CopyPicture xlScreen, xlBitmap
Sheet3.Paste Destination:=Sheet3.Range("A46")
Application.DisplayAlerts = True
Anyone knows how to make the simplier so it doesn't freeze randomly? Thank you for reading 
LinkBack URL
About LinkBacks
How to simplify code?
Register To Reply
Bookmarks