VBA: Code MONSTROSITY, EMBARRASSED TO SHOW BUT "NEED HELP".

B

bamaisgreat

Well-known Member
Joined
Jan 23, 2012
Messages
826
Office Version
  1. 365
Platform
  1. Windows
The code I have below is a major overkill but It works except there is a couple of bugs. The first is when I run the code, on the last line((Set rngfil = Range("A20,B20,C20,D20,J20,R20,U20"))) it puts in the "-" in the Range of cells, I dont need that. Each line may not always have data in it and sometimes there may only be a few of the cells with data in them. The reason I chose the "-" is so no cell will be empty to prevent the line of cells from getting out of line. Any help is appreciated, Thanks

Code: 
Sub ArchiveIt()
'next line adds character into empty cell'
Dim rngfil As Range, cell As Range
Dim NR As Long
Set ws1 = ActiveWorkbook.Sheets("JOB FORM")
Set rngfil = Range("A4,B4,C4,D4,J4,R4,U4")
Set rngfil = Range("A5,B5,C5,D5,J5,R5,U5")
Set rngfil = Range("A6,B6,C6,D6,J6,R6,U6")
Set rngfil = Range("A7,B7,C7,D7,J7,R7,U7")
Set rngfil = Range("A8,B8,C8,D8,J8,R8,U8")
Set rngfil = Range("A9,B9,C9,D9,J9,R9,U9")
Set rngfil = Range("A10,B10,C10,D10,J10,R10,U10")
Set rngfil = Range("A11,B11,C11,D11,J11,R11,U11")
Set rngfil = Range("A12,B12,C12,D12,J12,R12,U12")
Set rngfil = Range("A13,B13,C13,D13,J13,R13,U13")
Set rngfil = Range("A14,B14,C14,D14,J14,R14,U14")
Set rngfil = Range("A15,B15,C15,D15,J15,R15,U15")
Set rngfil = Range("A16,B16,C16,D16,J16,R16,U16")
Set rngfil = Range("A17,B17,C17,D17,J17,R17,U17")
Set rngfil = Range("A18,B18,C18,D18,J18,R18,U18")
Set rngfil = Range("A19,B19,C19,D19,J19,R19,U19")
Set rngfil = Range("A20,B20,C20,D20,J20,R20,U20")
For Each cell In rngfil
 If cell.Value = vbNullString Then
 cell.Value = "-"
 End If
 Next cell
Filename = "H:\Burney Table\CUTTING FORMS (Protected by QC)\fmi archive\My Book.xls"
Workbooks.Open (Filename)
 
NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A4").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B4").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C4").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D4").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J4").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R4").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T4").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U4").Value
NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A5").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B5").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C5").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D5").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J5").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R5").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T5").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U5").Value
NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A6").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B6").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C6").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D6").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J6").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R6").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T6").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U6").Value
 NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A7").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B7").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C7").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D7").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J7").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R7").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T7").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U7").Value
 NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A8").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B8").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C8").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D8").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J8").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R8").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T8").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U8").Value
 NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A9").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B9").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C9").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D9").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J9").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R9").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T9").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U9").Value
 NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A10").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B10").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C10").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D10").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J10").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R10").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T10").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U10").Value
 NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A11").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B11").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C11").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D11").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J11").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R11").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T11").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U11").Value
NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A12").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B12").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C12").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D12").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J12").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R12").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T12").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U12").Value
NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A13").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B13").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C13").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D13").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J13").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R13").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T13").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U13").Value
NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A14").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B14").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C14").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D14").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J14").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R14").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T14").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U14").Value
NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A15").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B15").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C15").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D15").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J15").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R15").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T15").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U15").Value
NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A16").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B16").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C16").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D16").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J16").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R16").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T16").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U16").Value
NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A17").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B17").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C17").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D17").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J17").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R17").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T17").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U17").Value
NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A18").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B18").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C18").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D18").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J18").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R18").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T18").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U18").Value
NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A19").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B19").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C19").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D19").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J19").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R19").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T19").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U19").Value
NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Sheet1").Range("A" & NR).Value = ws1.Range("A20").Value
    Sheets("Sheet1").Range("B" & NR).Value = ws1.Range("B20").Value
    Sheets("Sheet1").Range("C" & NR).Value = ws1.Range("C20").Value
    Sheets("Sheet1").Range("D" & NR).Value = ws1.Range("D20").Value
    Sheets("Sheet1").Range("E" & NR).Value = ws1.Range("J20").Value
    Sheets("Sheet1").Range("F" & NR).Value = ws1.Range("R20").Value
    Sheets("Sheet1").Range("G" & NR).Value = ws1.Range("T20").Value
    Sheets("Sheet1").Range("H" & NR).Value = ws1.Range("U20").Value

   
    ActiveWorkbook.save
    'ActiveWorkbook.Close
End Sub
 
Sort by date Sort by votes
Tony sorry to bother you again.
Im having a little problem with protecting the workbook.
Lots of people are Viewing the Master Archive workbook which is causing me trouble when I wish to execute the code below you provided for me
I need some steps on how to save the Master Archive workbook to a read only when all the data is transfered to it in the code.
I don want it to be a permanent read only. What are some options on this ?

Sub FINALIZED_BY_QC_job()
Dim newFileName As String
Dim appendtext As String
Dim rngfil As Range, cell As Range
Dim NR As Long, I As Long
If UCase(InputBox("Enter Password")) <> "1288" Then Exit Sub
With ActiveSheet
.Unprotect Password:="1288"
With .Range("J24").Interior
.Pattern = xlSolid
.PatternColorIndex = 1
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
appendtext = " -FINAL"
.Range("J24").FormulaR1C1 = appendtext
With ActiveWorkbook
oldFileName = .FullName
newFileName = Left(.FullName, InStrRev(.FullName, ".xls") - 1) _
& appendtext
.SaveAs Filename:=newFileName
End With
Kill oldFileName
ActiveWorkbook.Save
Set ws1 = ActiveWorkbook.Sheets("JOB CUTTING FORM")
SourcePath = ActiveWorkbook.Path
SourceFile = Left(ActiveWorkbook.name, InStrRev(ActiveWorkbook.name, ".xls") - 1) & "-PA.xls"

ActiveSheet.Shapes.Range(Array("Button 192")).Select
Selection.OnAction = "PURCH_COMMENTS_JOB"
Range("$H$1:$K$1").Locked = True

Cells.Select
Selection.Locked = True
Range("W4:W22").Select
Selection.Locked = False
Selection.FormulaHidden = False
ActiveSheet.EnableSelection = xlUnlockedCells
Range("W4").Select

Set rngfil = Range("B4,C4,H4,J4,T4,U4") 'first row of data to be processed
For r = 0 To 18 'row offset variable
EmptyRowCheck = ""
For Each cell In rngfil.Offset(r, 0) 'Concat values of cells in rngfil offset
EmptyRowCheck = EmptyRowCheck & cell
Next cell
If EmptyRowCheck = "" Then GoTo FoundEmptyRow ' if "" empty row of rngfil cells found so stop putting -
For Each cell In rngfil.Offset(r, 0) 'otherwise put - in any empty cell
If cell.Value = vbNullString Then
cell.Value = "-"
End If
Next cell
Next r
FoundEmptyRow: 'stop putting -
' Archive values to ....
Filename = "H:\Burney Table\CUTTING FORMS (Protected by QC)\Archive\Master Archive.xls"
Workbooks.Open (Filename)
HypoAddress = SourcePath & "\" & SourceFile
NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
For I = 0 To 18
Sheets("Sheet1").Range("A" & NR + I).Value = ws1.Range("B" & I + 4).Value
'Sheets("Sheet1").Range("B" & NR + I).Value = ws1.Range("B" & I + 4).Value
Sheets("Sheet1").Range("C" & NR + I).Value = ws1.Range("C" & I + 4).Value
Sheets("Sheet1").Range("D" & NR + I).Value = ws1.Range("H" & I + 4).Value
Sheets("Sheet1").Range("E" & NR + I).Value = ws1.Range("J" & I + 4).Value
Sheets("Sheet1").Range("F" & NR + I).Value = ws1.Range("T" & I + 4).Value
Sheets("Sheet1").Range("G" & NR + I).Value = ws1.Range("U" & I + 4).Value
'Sheets("Sheet1").Range("H" & NR + I).Value = ws1.Range("U" & I + 4).Value

HypoSubAddress = "'" & ws1.name & "'" & "!" & ws1.Range("H" & I + 4).Address
If Not ws1.Range("H" & I + 4).Value = "" Then
Sheets("Sheet1").Hyperlinks.Add Anchor:=Sheets("Sheet1").Range("H" & NR + I), Address:= _
HypoAddress, SubAddress:= _
HypoSubAddress, TextToDisplay:= _
"Link To...."
End If

Next I
ActiveWorkbook.Save
ActiveWorkbook.Close
.Protect Password:="1288", DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
ThisWorkbook.Save
Application.Quit
End Sub
Click to expand...
 
Upvote 0

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
Jamey,

I can't promise a solution but will give it some thought.
Please confirm /clarify:-
You, alone, need to be able to update the Archive file via this code?
Various other users open the file and need to modify or not modify ?
You do not want an older version to be saved over your latest update?
Any other relevant info?
 
Upvote 0
Tony,
Just thinking, is there just a simple way to connect 2 different workbooks with like a formula or something?
I have done a little research since I sent you the post, Im not sure but I think the "Master Archive"workbook that all the data is transfered to will not need any type of protection but if I could have a workbook connected to it somehow that always contains the same data but maybe as a readonly and maybe with like a different name "Public Master Archive" that will be in a different location and viewable by anyone . That way the Master will not be affected. Make Since ? Ideas ? Thanks for the help
 
Upvote 0
Tony, the code you provided me works great and has helped speed up our process a ton. I was wandering if you could make a slight modification?
Sometimes there maybe a empty row in the data that is being transfered to the Master Archive Workbook. Is there something that can be added so it will not transfer the blank rows.. Thanks Again
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Question
VBA compare values on different sheets.
Replies
5
Views
148
rlv01
R
B
  • Question
Matching Multiple Header Row Cell Values - Copy the data below to next available row.
Replies
2
Views
303
B-radK
B
J
  • Solved
VBA to compare rows in two different sheets, if match highlight cell
2
Replies
10
Views
780
kevin9999
K
S
  • Question
Date formatting issue sheet to VBA Array to Sheet
Replies
2
Views
204
MARK858
MARK858
T
  • Solved
Multiple columns into 2?
Replies
6
Views
142
Georgiboy
Georgiboy

Forum statistics

Threads
1,216,028
Messages
6,128,399
Members
449,447
Latest member
M V Arun

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top