I have come across the below Macro which works well in terms of importing the raw data I need to work on. I have a second sheet in the workbook with several formula that uses the imported data, however evertime I run the macro it amends my cell references in the formula from as an example (C2:C450) changes to (C2:C123), the 2nd value constantly changes to different values. Is there a way to stop the macro changing the formulas on a different sheet?
VBA Code:
ub Principale()
'Dichiarazione veriabili
Dim flag As String
Dim i
'----------------------Prepara lo schermo--------------------------------
'Inizializza la status bar (carica dati da wizard)
'Application.ScreenUpdating = False
Application.DisplayStatusBar = True
Application.StatusBar = "Downloading the data, please wait...."
'----------------------------------------
'creaCollection
Dim collStazioni As Collection
Set collStazioni = New Collection
'
'carica la collection
i = 1
While stazioni.Range("Stazioni").Offset(i) <> ""
On Error Resume Next
collStazioni.Add Array(stazioni.Range("Stazioni").Offset(i), _
stazioni.Range("Stazioni").Offset(i, 1), stazioni.Range("Stazioni").Offset(i, 2))
i = i + 1
Wend
'--------------------
'routines principali
If Not Manifest(flag, collStazioni) Then
If Not flag Like "" Then
MsgBox flag
End If
Application.StatusBar = False
Exit Sub
End If
If Not x502(flag) Then
If Not flag Like "" Then
MsgBox flag
End If
Application.StatusBar = False
Exit Sub
End If
Application.StatusBar = False
End Sub
Function Manifest(ByRef flag As String, ByRef collStazioni As Object) As Boolean
Manifest = True
Dim e As String, Y As String, c As String
Dim stn
Dim StrErrore As String
Dim Cella As Range
Dim intRow As Integer
Dim i As Integer
Dim Fine As Integer
Dim cell As Range
'Oggetti e connessione schermo
Dim pr As Object
Dim MyScreen As Object
'formule manuali
Application.Calculation = xlCalculationManual
'pulisci
Range("A4:Q10000").ClearContents
Set pr = New Connessione
'**************************
For Each stn In collStazioni
'<<<<<<< CONTROLLA CHE LA STAZIONE ESISTA >>>>>>>
If stn(0) Like "" Then GoTo prossimo
'************************************************
'Setta la sessione
If stn(1) Like "A" Then
If Not setConnection(MyScreen, fmanifest.cmbAvis.Text, pr, flag) Then
Manifest = False
Exit Function
End If
c = "x"
ElseIf stn(1) Like "B" Then
If Not setConnection(MyScreen, fmanifest.cmbBudget.Text, pr, flag) Then
Manifest = False
Exit Function
End If
c = "e"
ElseIf stn(1) Like "P" Then
If Not setConnection(MyScreen, fmanifest.cmbMaggiore.Text, pr, flag) Then
Manifest = False
Exit Function
End If
c = "y"
Else
Manifest = False
MsgBox "Devi settare correttamente il brand nel range stazioni", vbExclamation
Exit Function
End If
With MyScreen
'logga su it5
.putstring "/FOR " & c & "601.", 1, 7
If waitHost(MyScreen, "<ENTER>") Then
Manifest = False
Exit Function
End If
.putstring "NC", 2, 11
.putstring "9118", 2, 51
If waitHost(MyScreen, "<ENTER>") Then
Manifest = False
Exit Function
End If
'Itera stazioni
.putstring "/FOR MANIFEST.", 1, 7
'----------------
If waitHost(MyScreen, "<ENTER>") Then
Manifest = False
Exit Function
End If
.putstring "DS", 2, 9
.putstring "RES", 2, 18
.putstring stn(0), 2, 36
.putstring stn(1), 2, 54
.putstring Range("Start_Date"), 3, 13
.putstring Range("End_Date"), 3, 53
'----------------
If waitHost(MyScreen, "<ENTER>") Then
Manifest = False
Exit Function
End If
CiclaManifest:
For Each Cella In Range("Start:A100000")
If Cella = "" Then
Cella.Select
Exit For
End If
Next
Set Cella = ActiveCell
i = 1
intRow = 12
For intRow = 12 To 22
Cella.Offset(i - 1) = stn(0) 'stazione
Cella.Offset(i - 1, 1) = stn(1) 'brand
Cella.Offset(i - 1, 2) = .getstring(7, 12, 9) 'data da wizard
Cella.Offset(i - 1, 3) = .getstring(intRow, 2, 14) 'res num
Cella.Offset(i - 1, 4) = .getstring(intRow, 17, 19) 'name
Cella.Offset(i - 1, 5) = .getstring(intRow, 38, 4) 'time
Cella.Offset(i - 1, 7) = .getstring(intRow, 43, 6) 'flight number
Cella.Offset(i - 1, 8) = .getstring(intRow, 51, 1) 'group
Cella.Offset(i - 1, 9) = .getstring(intRow, 55, 5) 'rate
Cella.Offset(i - 1, 10) = .getstring(intRow, 61, 19) 'remarks
i = i + 1
Next
Fine = Range("A1").CurrentRegion.Rows.Count
i = 1
'cancella le celle vuote
For i = 1 To Fine
If Range("D" & i) = " " Then
Range("D" & i).Select
Selection.EntireRow.Delete
End If
If Range("E" & i) = " " Then
Range("E" & i).Select
Selection.EntireRow.Delete
End If
If Range("F" & i) = " " Then
Range("F" & i).Select
Selection.EntireRow.Delete
End If
If Range("H" & i) = " " Then
Range("H" & i).Select
Selection.EntireRow.Delete
End If
Next
If Not (.getstring(24, 2, 3) Like "END") Then
If waitHost(MyScreen, "<PA1>") Then
Manifest = False
Exit Function
End If
GoTo CiclaManifest
End If
End With
For Each cell In Range("F4:F10000")
If cell <> "" Then
cell.Offset(0, 11) = Left(cell, 2)
cell.Offset(0, 11).NumberFormat = "@"
End If
Next
prossimo:
Next stn
' Application.Calculation = xlCalculationAutomatic
End Function
Public Function x502(ByRef flag As String) As Boolean
x502 = True
Dim v As String
Dim i As Integer
Dim Fine As Integer
Dim FineRes As Integer
Dim IContinua As Integer
Dim cell As Range
'Oggetti e connessione schermo
Dim pr As Object
Dim MyScreen As Object
Application.Calculation = xlCalculationManual
IContinua = MsgBox("Download RES details", vbOKCancel)
If IContinua = vbCancel Then
For Each cell In Range("F4:F10000")
If cell <> "" Then
cell.Offset(0, 11) = Left(cell, 2)
cell.Offset(0, 11).NumberFormat = "@"
End If
Next
Application.Calculation = xlCalculationAutomatic
Exit Function
Else
Set pr = New Connessione
i = 1
FineRes = Range("a4").CurrentRegion.Rows.Count - 3
For i = 1 To FineRes
'assegna percorso, wizard code al brand
Select Case Range("Start").Offset(i, 1)
Case "A"
If Not setConnection(MyScreen, fmanifest.cmbAvis.Text, pr, flag) Then
x502 = False
Exit Function
End If
v = "X"
Case "B"
If Not setConnection(MyScreen, fmanifest.cmbBudget.Text, pr, flag) Then
x502 = False
Exit Function
End If
v = "E"
Case "P"
If Not setConnection(MyScreen, fmanifest.cmbMaggiore.Text, pr, flag) Then
x502 = False
Exit Function
End If
v = "L"
End Select
With MyScreen
.putstring "/FOR " & v & "502.", 1, 7
If waitHost(MyScreen, "<ENTER>") Then
x502 = False
Exit Function
End If
.putstring "DR", 2, 2
.putstring "r/" & Range("Start").Offset(i, 3), 9, 6
If waitHost(MyScreen, "<ENTER>") Then
x502 = False
Exit Function
End If
'verifica che la res sia trovata
If .getstring(2, 49, 3) = "F11" Or .getstring(2, 35, 5) = "ERROR" Then
Range("Start").Offset(i, 11) = .getstring(20, 6, 30) 'LCL CONTACT
'range("Start").Offset(i, 11) = .getstring(2, 21, 6) 'WIZARD #
'Range("Start").Offset(i, 12) = .getstring(22, 6, 7) 'AWD #
Range("Start").Offset(i, 12) = .getstring(8, 6, 12) 'ETT
Range("Start").Offset(i, 13) = .getstring(7, 6, 5) 'ILC
Range("Start").Offset(i, 14) = .getstring(19, 6, 20) 'source
Range("Start").Offset(i, 15) = .getstring(21, 6, 20) 'source
Range("Start").Offset(i, 16) = Left(Range("start").Offset(i, 5), 2)
Range("Start").Offset(i, 16).NumberFormat = "@"
.putstring "/FOR " & v & "502.", 1, 7
If waitHost(MyScreen, "<ENTER>") Then
x502 = False
Exit Function
End If
.putstring "DT", 2, 2
.putstring "r/" & Range("Start").Offset(i, 3), 9, 6
.putstring Range("Start").Offset(i, 14), 19, 6
If waitHost(MyScreen, "<ENTER>") Then
x502 = False
Exit Function
End If
Range("Start").Offset(i, 6) = .getstring(2, 37, 20) 'Broker
Else
MsgBox "Click to load your Game Plan!"
End If
End With
Next
'resetta schermo
ActiveWindow.ScrollRow = 1
Range("Start_Date").Select
'formule automatiche
Application.Calculation = xlCalculationAutomatic
End If
End Function
