tradingpassion
New Member
- Joined
- Nov 30, 2003
- Messages
- 7
I have an excel file and I wrote some code and I am not sure what happened that the file is getting bigger and bigger. Initially the file was 600 KB and i made very mionor changes in the formatting and it made the file 2.17 MB..i deleted those changes but the file is still 2.17 MB.
here is the code i am using :
Dim arData As Variant
Const wbk = "CIP Submit Form v1.xls"
Private Sub CommandButton1_Click()
Sheets("Sample Sheet").Select
ActiveSheet.Cells(1, 1).Select
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng1 As Range
Dim rng2 As Range
Dim tmprng As Range
Dim rwNum As Integer
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
Select Case Target.Address
Case "$AL$18": 'EP10:IT202
'Set rng1 = ActiveSheet.Range("A10:DO202")
Set rng1 = ActiveWorkbook.Sheets("Data Sheet").Range("A10:DZ202")
Set tmprng = ActiveWorkbook.Sheets("Data Sheet").Range("A10:A202") 'Match works only on linear array
readData ActiveSheet.Range("AL18").Value, rng1, tmprng
putData 0
Case "$AH$18": 'EQ10:IT202
Set rng1 = ActiveWorkbook.Sheets("Data Sheet").Range("B10:DZ202")
Set tmprng = ActiveWorkbook.Sheets("Data Sheet").Range("B10:B202") 'Match works only on linear array
readData ActiveSheet.Range("AH18").Value, rng1, tmprng
putData -1
'now get the 'Site'
'Because It is at the left side to the "Site Entity#"
'so we can't lookup it.
'That's why we need the row number of lookup value
'and calculate the adjacent cell address
'
rwNum = getRowNum(ActiveSheet.Range("AH18").Value, tmprng)
Sheets("Case Sheet").Range("AL18").Value = ActiveWorkbook.Sheets("Data Sheet").Range("A" & (10 + rwNum - 1)).Value
End Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Private Function getRowNum(vlu2Match, linearRange As Range) As Integer
'On Error Resume Next
getRowNum = Application.WorksheetFunction.Match(vlu2Match, linearRange, 0)
End Function
Private Sub readData(vlu2Match, rng As Range, matchRng As Range)
On Error Resume Next
Dim col1 As Integer
Dim rowNum As Integer
Dim colNum As Integer
col1 = rng.Columns.Count
'Start from 2 because 1st column holds the
'value, we are searching for.
ReDim arData(2 To col1)
'all data is present in the same sheet and in adjacent rows
'so can be easily retrieved through loop.
'But it works slower, because in each iteration it perform Vlookup
'which is slower than simply getting values.
'For i = 2 To col1
' arData(i) = Application.WorksheetFunction.VLookup(vlu2Match, rng, i, False)
'Next i
'==========================
'Below is the optimized code to get values instead of vlookup
'it works faster than VLokup
'
'To get data from "Data Sheet" we need to match
'corresponding row. Thats why we need the rowNum
rowNum = getRowNum(vlu2Match, matchRng) - 1
colNum = matchRng.Column
'We get the rownum, so we need to loop through columns
If rowNum > 0 Then
For i = 2 To col1
arData(i) = Worksheets("Data Sheet").Cells(10 + rowNum, colNum + (i - 1)).Value
Next
End If
'
'===========================
End Sub
Private Sub putData(ofst As Integer)
On Error Resume Next
With Sheets("Case Sheet")
ActiveSheet.Unprotect ""
If ofst > -1 Then .Range("AH18") = arData(ofst + 2)
If ofst > -3 Then .Range("M17") = arData(ofst + 4)
If ofst > -4 Then
.Range("H17") = arData(ofst + 5)
.Range("M19") = arData(ofst + 8)
.Range("H19") = arData(ofst + 9)
.Range("AH14") = arData(ofst + 3)
.Range("AJ10") = arData(ofst + 6)
.Range("M81") = arData(ofst + 124)
.Range("O81") = arData(ofst + 125)
.Range("Q81") = arData(ofst + 126)
.Range("S81") = arData(ofst + 127)
.Range("U81") = arData(ofst + 128)
.Range("W81") = arData(ofst + 129)
.Range("Y81") = arData(ofst + 130)
.Range("C45") = arData(ofst + 62)
End If
.Range("I7") = arData(ofst + 10)
.Range("B35") = arData(ofst + 54)
.Range("B35") = arData(ofst + 54)
' Filing Names
.Range("AG37") = arData(ofst + 13)
.Range("AG39") = arData(ofst + 17)
.Range("AG41") = arData(ofst + 21)
.Range("AG43") = arData(ofst + 25)
.Range("AG45") = arData(ofst + 29)
.Range("AG47") = arData(ofst + 33)
.Range("AG49") = arData(ofst + 37)
.Range("AG51") = arData(ofst + 41)
.Range("AG53") = arData(ofst + 45)
.Range("AG55") = arData(ofst + 49)
.Range("AG57") = arData(ofst + 91)
.Range("AG59") = arData(ofst + 95)
.Range("AG61") = arData(ofst + 99)
.Range("AG63") = arData(ofst + 103)
.Range("AG65") = arData(ofst + 120)
'Filling FAX or Interim
.Range("AP37") = arData(ofst + 15)
.Range("AP39") = arData(ofst + 19)
.Range("AP41") = arData(ofst + 23)
.Range("AP43") = arData(ofst + 27)
.Range("AP45") = arData(ofst + 31)
.Range("AP47") = arData(ofst + 35)
.Range("AP49") = arData(ofst + 39)
.Range("AP51") = arData(ofst + 43)
.Range("Ap53") = arData(ofst + 47)
.Range("AP55") = arData(ofst + 51)
.Range("AP57") = arData(ofst + 94)
.Range("AP59") = arData(ofst + 98)
.Range("AP61") = arData(ofst + 102)
.Range("AP63") = arData(ofst + 106)
.Range("AP65") = arData(ofst + 123)
'Filling Email or Final
.Range("AU37") = arData(ofst + 16)
.Range("AU39") = arData(ofst + 20)
.Range("AU41") = arData(ofst + 24)
.Range("AU43") = arData(ofst + 28)
.Range("AU45") = arData(ofst + 32)
.Range("AU47") = arData(ofst + 36)
.Range("AU49") = arData(ofst + 40)
.Range("AU51") = arData(ofst + 44)
.Range("AU53") = arData(ofst + 48)
.Range("AU55") = arData(ofst + 52)
.Range("AU57") = arData(ofst + 93)
.Range("AU59") = arData(ofst + 97)
.Range("AU61") = arData(ofst + 101)
.Range("AU63") = arData(ofst + 105)
.Range("AU65") = arData(ofst + 122)
'.Range("AU65") = arData(ofst + 105)
'New added
'.Range("AH16") = arData(ofst + 107)
.Range("AB73") = arData(ofst + 109)
'\\\\\\\\\\\\\\\\\\Working on it right now
'Filing Entity
.Range("AB37") = arData(ofst + 14)
.Range("AB39") = arData(ofst + 18)
.Range("AB41") = arData(ofst + 22)
.Range("AB43") = arData(ofst + 26)
.Range("AB45") = arData(ofst + 30)
.Range("AB47") = arData(ofst + 34)
.Range("AB49") = arData(ofst + 38)
.Range("AB51") = arData(ofst + 42)
.Range("AB53") = arData(ofst + 46)
.Range("AB55") = arData(ofst + 50)
.Range("AB57") = arData(ofst + 92)
.Range("AB59") = arData(ofst + 96)
.Range("AB61") = arData(ofst + 100)
.Range("AB63") = arData(ofst + 104)
.Range("AB65") = arData(ofst + 121)
'need not to be linked anymore
'.Range("AH20") = Workbooks(wbk).Sheets(1).Range("BM48").Value
'.Range("AH22") = Workbooks(wbk).Sheets(1).Range("BM50").Value
'.Range("AH24") = Workbooks(wbk).Sheets(1).Range("BM46").Value
'Setting checkboxes
'Ist column
If arData(ofst + 54) = "X" Then .CheckBox1.Value = True Else .CheckBox1.Value = False
If arData(ofst + 53) = "X" Then .CheckBox2.Value = True Else .CheckBox2.Value = False
If arData(ofst + 61) = "X" Then .CheckBox3.Value = True Else .CheckBox3.Value = False
If arData(ofst + 60) = "X" Then .CheckBox4.Value = True Else .CheckBox4.Value = False
If arData(ofst + 69) = "X" Then .CheckBox5.Value = True Else .CheckBox5.Value = False
If arData(ofst + 70) = "X" Then .CheckBox6.Value = True Else .CheckBox6.Value = False
If arData(ofst + 71) = "X" Then .CheckBox7.Value = True Else .CheckBox7.Value = False
If arData(ofst + 72) = "X" Then .CheckBox8.Value = True Else .CheckBox8.Value = False
If arData(ofst + 55) = "X" Then .CheckBox9.Value = True Else .CheckBox9.Value = False
If arData(ofst + 75) = "X" Then .CheckBox10.Value = True Else .CheckBox10.Value = False
If arData(ofst + 76) = "X" Then .CheckBox11.Value = True Else .CheckBox11.Value = False
If arData(ofst + 56) = "X" Then .CheckBox12.Value = True Else .CheckBox12.Value = False
If arData(ofst + 78) = "X" Then .CheckBox13.Value = True Else .CheckBox13.Value = False
If arData(ofst + 79) = "X" Then .CheckBox14.Value = True Else .CheckBox14.Value = False
If arData(ofst + 82) = "X" Then .CheckBox15.Value = True Else .CheckBox15.Value = False
If arData(ofst + 83) = "X" Then .CheckBox16.Value = True Else .CheckBox16.Value = False
If arData(ofst + 84) = "X" Then .CheckBox17.Value = True Else .CheckBox17.Value = False
If arData(ofst + 85) = "X" Then .CheckBox18.Value = True Else .CheckBox18.Value = False
If arData(ofst + 87) = "X" Then .CheckBox19.Value = True Else .CheckBox19.Value = False
If arData(ofst + 88) = "X" Then .CheckBox20.Value = True Else .CheckBox20.Value = False
'IInd column
If arData(ofst + 110) = "X" Then .CheckBox21.Value = True Else .CheckBox21.Value = False 'AR1
If arData(ofst + 111) = "X" Then .CheckBox22.Value = True Else .CheckBox22.Value = False 'AR2
If arData(ofst + 112) = "X" Then .CheckBox23.Value = True Else .CheckBox23.Value = False 'AR3
If arData(ofst + 113) = "X" Then .CheckBox24.Value = True Else .CheckBox24.Value = False 'AR4
If arData(ofst + 114) = "X" Then .CheckBox39.Value = True Else .CheckBox39.Value = False 'AR5
' *** HERE IS A BLANK CHECK BOX ***
If arData(ofst + 73) = "X" Then .CheckBox25.Value = True Else .CheckBox25.Value = False
If arData(ofst + 74) = "X" Then .CheckBox26.Value = True Else .CheckBox26.Value = False
If arData(ofst + 115) = "X" Then .CheckBox27.Value = True Else .CheckBox27.Value = False 'AR6
If arData(ofst + 116) = "X" Then .CheckBox28.Value = True Else .CheckBox28.Value = False 'AR7
If arData(ofst + 57) = "X" Then .CheckBox29.Value = True Else .CheckBox29.Value = False
If arData(ofst + 77) = "X" Then .CheckBox30.Value = True Else .CheckBox30.Value = False
If arData(ofst + 80) = "X" Then .CheckBox31.Value = True Else .CheckBox31.Value = False
If arData(ofst + 81) = "X" Then .CheckBox32.Value = True Else .CheckBox32.Value = False
If arData(ofst + 117) = "X" Then .CheckBox33.Value = True Else .CheckBox33.Value = False 'AR8
If arData(ofst + 118) = "X" Then .CheckBox34.Value = True Else .CheckBox34.Value = False 'AR9
If arData(ofst + 119) = "X" Then .CheckBox35.Value = True Else .CheckBox35.Value = False 'AR10
If arData(ofst + 86) = "X" Then .CheckBox36.Value = True Else .CheckBox36.Value = False
If arData(ofst + 89) = "X" Then .CheckBox37.Value = True Else .CheckBox37.Value = False
If arData(ofst + 90) = "X" Then .CheckBox38.Value = True Else .CheckBox38.Value = False
ActiveSheet.Protect
End With
End Sub
here is the code i am using :
Dim arData As Variant
Const wbk = "CIP Submit Form v1.xls"
Private Sub CommandButton1_Click()
Sheets("Sample Sheet").Select
ActiveSheet.Cells(1, 1).Select
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng1 As Range
Dim rng2 As Range
Dim tmprng As Range
Dim rwNum As Integer
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
Select Case Target.Address
Case "$AL$18": 'EP10:IT202
'Set rng1 = ActiveSheet.Range("A10:DO202")
Set rng1 = ActiveWorkbook.Sheets("Data Sheet").Range("A10:DZ202")
Set tmprng = ActiveWorkbook.Sheets("Data Sheet").Range("A10:A202") 'Match works only on linear array
readData ActiveSheet.Range("AL18").Value, rng1, tmprng
putData 0
Case "$AH$18": 'EQ10:IT202
Set rng1 = ActiveWorkbook.Sheets("Data Sheet").Range("B10:DZ202")
Set tmprng = ActiveWorkbook.Sheets("Data Sheet").Range("B10:B202") 'Match works only on linear array
readData ActiveSheet.Range("AH18").Value, rng1, tmprng
putData -1
'now get the 'Site'
'Because It is at the left side to the "Site Entity#"
'so we can't lookup it.
'That's why we need the row number of lookup value
'and calculate the adjacent cell address
'
rwNum = getRowNum(ActiveSheet.Range("AH18").Value, tmprng)
Sheets("Case Sheet").Range("AL18").Value = ActiveWorkbook.Sheets("Data Sheet").Range("A" & (10 + rwNum - 1)).Value
End Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Private Function getRowNum(vlu2Match, linearRange As Range) As Integer
'On Error Resume Next
getRowNum = Application.WorksheetFunction.Match(vlu2Match, linearRange, 0)
End Function
Private Sub readData(vlu2Match, rng As Range, matchRng As Range)
On Error Resume Next
Dim col1 As Integer
Dim rowNum As Integer
Dim colNum As Integer
col1 = rng.Columns.Count
'Start from 2 because 1st column holds the
'value, we are searching for.
ReDim arData(2 To col1)
'all data is present in the same sheet and in adjacent rows
'so can be easily retrieved through loop.
'But it works slower, because in each iteration it perform Vlookup
'which is slower than simply getting values.
'For i = 2 To col1
' arData(i) = Application.WorksheetFunction.VLookup(vlu2Match, rng, i, False)
'Next i
'==========================
'Below is the optimized code to get values instead of vlookup
'it works faster than VLokup
'
'To get data from "Data Sheet" we need to match
'corresponding row. Thats why we need the rowNum
rowNum = getRowNum(vlu2Match, matchRng) - 1
colNum = matchRng.Column
'We get the rownum, so we need to loop through columns
If rowNum > 0 Then
For i = 2 To col1
arData(i) = Worksheets("Data Sheet").Cells(10 + rowNum, colNum + (i - 1)).Value
Next
End If
'
'===========================
End Sub
Private Sub putData(ofst As Integer)
On Error Resume Next
With Sheets("Case Sheet")
ActiveSheet.Unprotect ""
If ofst > -1 Then .Range("AH18") = arData(ofst + 2)
If ofst > -3 Then .Range("M17") = arData(ofst + 4)
If ofst > -4 Then
.Range("H17") = arData(ofst + 5)
.Range("M19") = arData(ofst + 8)
.Range("H19") = arData(ofst + 9)
.Range("AH14") = arData(ofst + 3)
.Range("AJ10") = arData(ofst + 6)
.Range("M81") = arData(ofst + 124)
.Range("O81") = arData(ofst + 125)
.Range("Q81") = arData(ofst + 126)
.Range("S81") = arData(ofst + 127)
.Range("U81") = arData(ofst + 128)
.Range("W81") = arData(ofst + 129)
.Range("Y81") = arData(ofst + 130)
.Range("C45") = arData(ofst + 62)
End If
.Range("I7") = arData(ofst + 10)
.Range("B35") = arData(ofst + 54)
.Range("B35") = arData(ofst + 54)
' Filing Names
.Range("AG37") = arData(ofst + 13)
.Range("AG39") = arData(ofst + 17)
.Range("AG41") = arData(ofst + 21)
.Range("AG43") = arData(ofst + 25)
.Range("AG45") = arData(ofst + 29)
.Range("AG47") = arData(ofst + 33)
.Range("AG49") = arData(ofst + 37)
.Range("AG51") = arData(ofst + 41)
.Range("AG53") = arData(ofst + 45)
.Range("AG55") = arData(ofst + 49)
.Range("AG57") = arData(ofst + 91)
.Range("AG59") = arData(ofst + 95)
.Range("AG61") = arData(ofst + 99)
.Range("AG63") = arData(ofst + 103)
.Range("AG65") = arData(ofst + 120)
'Filling FAX or Interim
.Range("AP37") = arData(ofst + 15)
.Range("AP39") = arData(ofst + 19)
.Range("AP41") = arData(ofst + 23)
.Range("AP43") = arData(ofst + 27)
.Range("AP45") = arData(ofst + 31)
.Range("AP47") = arData(ofst + 35)
.Range("AP49") = arData(ofst + 39)
.Range("AP51") = arData(ofst + 43)
.Range("Ap53") = arData(ofst + 47)
.Range("AP55") = arData(ofst + 51)
.Range("AP57") = arData(ofst + 94)
.Range("AP59") = arData(ofst + 98)
.Range("AP61") = arData(ofst + 102)
.Range("AP63") = arData(ofst + 106)
.Range("AP65") = arData(ofst + 123)
'Filling Email or Final
.Range("AU37") = arData(ofst + 16)
.Range("AU39") = arData(ofst + 20)
.Range("AU41") = arData(ofst + 24)
.Range("AU43") = arData(ofst + 28)
.Range("AU45") = arData(ofst + 32)
.Range("AU47") = arData(ofst + 36)
.Range("AU49") = arData(ofst + 40)
.Range("AU51") = arData(ofst + 44)
.Range("AU53") = arData(ofst + 48)
.Range("AU55") = arData(ofst + 52)
.Range("AU57") = arData(ofst + 93)
.Range("AU59") = arData(ofst + 97)
.Range("AU61") = arData(ofst + 101)
.Range("AU63") = arData(ofst + 105)
.Range("AU65") = arData(ofst + 122)
'.Range("AU65") = arData(ofst + 105)
'New added
'.Range("AH16") = arData(ofst + 107)
.Range("AB73") = arData(ofst + 109)
'\\\\\\\\\\\\\\\\\\Working on it right now
'Filing Entity
.Range("AB37") = arData(ofst + 14)
.Range("AB39") = arData(ofst + 18)
.Range("AB41") = arData(ofst + 22)
.Range("AB43") = arData(ofst + 26)
.Range("AB45") = arData(ofst + 30)
.Range("AB47") = arData(ofst + 34)
.Range("AB49") = arData(ofst + 38)
.Range("AB51") = arData(ofst + 42)
.Range("AB53") = arData(ofst + 46)
.Range("AB55") = arData(ofst + 50)
.Range("AB57") = arData(ofst + 92)
.Range("AB59") = arData(ofst + 96)
.Range("AB61") = arData(ofst + 100)
.Range("AB63") = arData(ofst + 104)
.Range("AB65") = arData(ofst + 121)
'need not to be linked anymore
'.Range("AH20") = Workbooks(wbk).Sheets(1).Range("BM48").Value
'.Range("AH22") = Workbooks(wbk).Sheets(1).Range("BM50").Value
'.Range("AH24") = Workbooks(wbk).Sheets(1).Range("BM46").Value
'Setting checkboxes
'Ist column
If arData(ofst + 54) = "X" Then .CheckBox1.Value = True Else .CheckBox1.Value = False
If arData(ofst + 53) = "X" Then .CheckBox2.Value = True Else .CheckBox2.Value = False
If arData(ofst + 61) = "X" Then .CheckBox3.Value = True Else .CheckBox3.Value = False
If arData(ofst + 60) = "X" Then .CheckBox4.Value = True Else .CheckBox4.Value = False
If arData(ofst + 69) = "X" Then .CheckBox5.Value = True Else .CheckBox5.Value = False
If arData(ofst + 70) = "X" Then .CheckBox6.Value = True Else .CheckBox6.Value = False
If arData(ofst + 71) = "X" Then .CheckBox7.Value = True Else .CheckBox7.Value = False
If arData(ofst + 72) = "X" Then .CheckBox8.Value = True Else .CheckBox8.Value = False
If arData(ofst + 55) = "X" Then .CheckBox9.Value = True Else .CheckBox9.Value = False
If arData(ofst + 75) = "X" Then .CheckBox10.Value = True Else .CheckBox10.Value = False
If arData(ofst + 76) = "X" Then .CheckBox11.Value = True Else .CheckBox11.Value = False
If arData(ofst + 56) = "X" Then .CheckBox12.Value = True Else .CheckBox12.Value = False
If arData(ofst + 78) = "X" Then .CheckBox13.Value = True Else .CheckBox13.Value = False
If arData(ofst + 79) = "X" Then .CheckBox14.Value = True Else .CheckBox14.Value = False
If arData(ofst + 82) = "X" Then .CheckBox15.Value = True Else .CheckBox15.Value = False
If arData(ofst + 83) = "X" Then .CheckBox16.Value = True Else .CheckBox16.Value = False
If arData(ofst + 84) = "X" Then .CheckBox17.Value = True Else .CheckBox17.Value = False
If arData(ofst + 85) = "X" Then .CheckBox18.Value = True Else .CheckBox18.Value = False
If arData(ofst + 87) = "X" Then .CheckBox19.Value = True Else .CheckBox19.Value = False
If arData(ofst + 88) = "X" Then .CheckBox20.Value = True Else .CheckBox20.Value = False
'IInd column
If arData(ofst + 110) = "X" Then .CheckBox21.Value = True Else .CheckBox21.Value = False 'AR1
If arData(ofst + 111) = "X" Then .CheckBox22.Value = True Else .CheckBox22.Value = False 'AR2
If arData(ofst + 112) = "X" Then .CheckBox23.Value = True Else .CheckBox23.Value = False 'AR3
If arData(ofst + 113) = "X" Then .CheckBox24.Value = True Else .CheckBox24.Value = False 'AR4
If arData(ofst + 114) = "X" Then .CheckBox39.Value = True Else .CheckBox39.Value = False 'AR5
' *** HERE IS A BLANK CHECK BOX ***
If arData(ofst + 73) = "X" Then .CheckBox25.Value = True Else .CheckBox25.Value = False
If arData(ofst + 74) = "X" Then .CheckBox26.Value = True Else .CheckBox26.Value = False
If arData(ofst + 115) = "X" Then .CheckBox27.Value = True Else .CheckBox27.Value = False 'AR6
If arData(ofst + 116) = "X" Then .CheckBox28.Value = True Else .CheckBox28.Value = False 'AR7
If arData(ofst + 57) = "X" Then .CheckBox29.Value = True Else .CheckBox29.Value = False
If arData(ofst + 77) = "X" Then .CheckBox30.Value = True Else .CheckBox30.Value = False
If arData(ofst + 80) = "X" Then .CheckBox31.Value = True Else .CheckBox31.Value = False
If arData(ofst + 81) = "X" Then .CheckBox32.Value = True Else .CheckBox32.Value = False
If arData(ofst + 117) = "X" Then .CheckBox33.Value = True Else .CheckBox33.Value = False 'AR8
If arData(ofst + 118) = "X" Then .CheckBox34.Value = True Else .CheckBox34.Value = False 'AR9
If arData(ofst + 119) = "X" Then .CheckBox35.Value = True Else .CheckBox35.Value = False 'AR10
If arData(ofst + 86) = "X" Then .CheckBox36.Value = True Else .CheckBox36.Value = False
If arData(ofst + 89) = "X" Then .CheckBox37.Value = True Else .CheckBox37.Value = False
If arData(ofst + 90) = "X" Then .CheckBox38.Value = True Else .CheckBox38.Value = False
ActiveSheet.Protect
End With
End Sub
