E
ejohnson
Tried searching the groups but didn't have any success in finding a
solution. Created a macro that is supposed to loop through a range of
cells and compare each cell to another range of cells. If and when it
finds a match it then looks in another column on that same row, grabs
the value it finds there, appends it to a variable and moves on to the
next cell in the second loop. Once it completes the second loop
lookup, it is supposed to write the variable to another cell and reset
the variable to nothing.
What is happening is that certain for certain members in the first
lookup range it is not writing the variable to the screen (it does
find all the members and stores the string in the variable). It
appears that when it tries to write the variable to the cell I get an
"Run time error 7: Out of Memory".
I have closed everything on this computer (running W2k and Excel 2000)
and just ran the macro without success. I have also tried running it
from a much more powerful pc with XP and Excel 2002 SP3 and have had
no luck. Anyone have any suggestions on how I can correct this
problem? Code below.
TIA!
Erik
Sub CreateDownfootMod()
'declare variables
Dim rngLookupAccounts As Range
Dim rngLookupRange As Range
Dim rngFormulaDest As Range
Dim rngFormulaMember As Range
Dim oAccount As Object 'accounts to look up
Dim oCell As Object 'each cell in range of accounts to look for the
account
Dim strFormula As String
'
'On Error Resume Next
'prompt user for the downfoot destination column
Set rngFormulaDest = Application.InputBox(prompt:="Select column
to place formula in", _
Title:="Prompt for
formula destination column", _
Default:=ActiveCell.Address, _
Type:=8)
If rngFormulaDest Is Nothing Then
MsgBox ("Downfoot creation cancelled. No downfoots
created.")
Exit Sub
End If
'prompt user for the column where the members to be included in
the formula are located
Set rngFormulaMember = Application.InputBox(prompt:="Select the
column that contains the members to be included in the formula", _
Title:="Prompt for
column of formula members", _
Default:=ActiveCell.Address, _
Type:=8)
If rngFormulaMember Is Nothing Then
MsgBox ("Downfoot creation cancelled. No downfoots
created.")
Exit Sub
End If
'MsgBox (rngFormulaDest.Column)
'prompt user for the range of cells to generate downfoot formulas
for.
Set rngLookupAccounts = Application.InputBox(prompt:="Select the
cells to generate downfoot formulas for.", _
Title:="Prompt for
accounts to lookup", _
Default:=ActiveCell.Address, _
Type:=8)
If rngLookupAccounts Is Nothing Then
MsgBox ("Downfoot creation cancelled. No downfoots
created.")
Exit Sub
End If
'MsgBox (rngLookupAccounts.Column)
'
'prompt user to select cells that contain the downfoot definitions
Set rngLookupRange = Application.InputBox(prompt:="Select the
cells containing the parent definition", _
Title:="Prompt for
lookup range", _
Default:=ActiveCell.Address, _
Type:=8)
If rngLookupRange Is Nothing Then
MsgBox ("Downfoot creation cancelled. No downfoots
created.")
Exit Sub
End If
Application.StatusBar = "Executing formula creation. Please
wait...."
'initialize formula string
strFormula = ""
Application.ScreenUpdating = False
'loop through each cell in downfoot formula and add to formula
string
For Each oAccount In rngLookupAccounts
For Each oCell In rngLookupRange
If Trim(UCase(oCell)) = Trim(UCase(oAccount)) Then
'MsgBox (Trim(UCase(oCell)))
'MsgBox (Trim(UCase(oAccount)))
'if blank string then add 'Downfoot(' prefix
If Len(strFormula) = 0 Then
strFormula = "+ "
End If
'concatenate cells to formula string. Second offset
parameter should be set to
'the number of columns to move to locate name of the
member that is to be used
'in the formula. Negative numbers moves the left,
positive to the right.
'THE OFFSET VALUE MAY NEED TO BE CHANGED TO OBTAIN THE
NAME FROM THE CORRECT COLUMN
'strFormula = strFormula & "[" & oCell.Offset(0,
-2).Value & "],"
strFormula = strFormula & "[" & oCell.Offset(0,
rngFormulaMember.Column - rngLookupRange.Column).Value & "] + "
End If
Next
'after formula is concatenated check for "," at end of string
If Right(strFormula, 2) = "+ " Then
strFormula = Left(strFormula, Len(strFormula) - 3)
End If
'set destination cell equal to strFormula. Second offset
parameter should be set to
'then number of columns to move to write the formula to the
proper location. Negative
'numbers moves the left, positive to the right.
'MsgBox (strFormula)
'THE OFFSET VALUE MAY NEED TO BE CHANGED TO PLACE DOWNFOOT IN
THE CORRECT COLUMN.
If strFormula <> "" Then
'Commented out. Destination now dynamically determined.
'oAccount.Offset(0, 4).Value = strFormula
oAccount.Offset(0, rngFormulaDest.Column -
rngLookupAccounts.Column).Value = strFormula
End If
strFormula = ""
Next
'
Application.ScreenUpdating = True
Application.StatusBar = False
MsgBox ("Downfoot creation complete!")
End Sub
solution. Created a macro that is supposed to loop through a range of
cells and compare each cell to another range of cells. If and when it
finds a match it then looks in another column on that same row, grabs
the value it finds there, appends it to a variable and moves on to the
next cell in the second loop. Once it completes the second loop
lookup, it is supposed to write the variable to another cell and reset
the variable to nothing.
What is happening is that certain for certain members in the first
lookup range it is not writing the variable to the screen (it does
find all the members and stores the string in the variable). It
appears that when it tries to write the variable to the cell I get an
"Run time error 7: Out of Memory".
I have closed everything on this computer (running W2k and Excel 2000)
and just ran the macro without success. I have also tried running it
from a much more powerful pc with XP and Excel 2002 SP3 and have had
no luck. Anyone have any suggestions on how I can correct this
problem? Code below.
TIA!
Erik
Sub CreateDownfootMod()
'declare variables
Dim rngLookupAccounts As Range
Dim rngLookupRange As Range
Dim rngFormulaDest As Range
Dim rngFormulaMember As Range
Dim oAccount As Object 'accounts to look up
Dim oCell As Object 'each cell in range of accounts to look for the
account
Dim strFormula As String
'
'On Error Resume Next
'prompt user for the downfoot destination column
Set rngFormulaDest = Application.InputBox(prompt:="Select column
to place formula in", _
Title:="Prompt for
formula destination column", _
Default:=ActiveCell.Address, _
Type:=8)
If rngFormulaDest Is Nothing Then
MsgBox ("Downfoot creation cancelled. No downfoots
created.")
Exit Sub
End If
'prompt user for the column where the members to be included in
the formula are located
Set rngFormulaMember = Application.InputBox(prompt:="Select the
column that contains the members to be included in the formula", _
Title:="Prompt for
column of formula members", _
Default:=ActiveCell.Address, _
Type:=8)
If rngFormulaMember Is Nothing Then
MsgBox ("Downfoot creation cancelled. No downfoots
created.")
Exit Sub
End If
'MsgBox (rngFormulaDest.Column)
'prompt user for the range of cells to generate downfoot formulas
for.
Set rngLookupAccounts = Application.InputBox(prompt:="Select the
cells to generate downfoot formulas for.", _
Title:="Prompt for
accounts to lookup", _
Default:=ActiveCell.Address, _
Type:=8)
If rngLookupAccounts Is Nothing Then
MsgBox ("Downfoot creation cancelled. No downfoots
created.")
Exit Sub
End If
'MsgBox (rngLookupAccounts.Column)
'
'prompt user to select cells that contain the downfoot definitions
Set rngLookupRange = Application.InputBox(prompt:="Select the
cells containing the parent definition", _
Title:="Prompt for
lookup range", _
Default:=ActiveCell.Address, _
Type:=8)
If rngLookupRange Is Nothing Then
MsgBox ("Downfoot creation cancelled. No downfoots
created.")
Exit Sub
End If
Application.StatusBar = "Executing formula creation. Please
wait...."
'initialize formula string
strFormula = ""
Application.ScreenUpdating = False
'loop through each cell in downfoot formula and add to formula
string
For Each oAccount In rngLookupAccounts
For Each oCell In rngLookupRange
If Trim(UCase(oCell)) = Trim(UCase(oAccount)) Then
'MsgBox (Trim(UCase(oCell)))
'MsgBox (Trim(UCase(oAccount)))
'if blank string then add 'Downfoot(' prefix
If Len(strFormula) = 0 Then
strFormula = "+ "
End If
'concatenate cells to formula string. Second offset
parameter should be set to
'the number of columns to move to locate name of the
member that is to be used
'in the formula. Negative numbers moves the left,
positive to the right.
'THE OFFSET VALUE MAY NEED TO BE CHANGED TO OBTAIN THE
NAME FROM THE CORRECT COLUMN
'strFormula = strFormula & "[" & oCell.Offset(0,
-2).Value & "],"
strFormula = strFormula & "[" & oCell.Offset(0,
rngFormulaMember.Column - rngLookupRange.Column).Value & "] + "
End If
Next
'after formula is concatenated check for "," at end of string
If Right(strFormula, 2) = "+ " Then
strFormula = Left(strFormula, Len(strFormula) - 3)
End If
'set destination cell equal to strFormula. Second offset
parameter should be set to
'then number of columns to move to write the formula to the
proper location. Negative
'numbers moves the left, positive to the right.
'MsgBox (strFormula)
'THE OFFSET VALUE MAY NEED TO BE CHANGED TO PLACE DOWNFOOT IN
THE CORRECT COLUMN.
If strFormula <> "" Then
'Commented out. Destination now dynamically determined.
'oAccount.Offset(0, 4).Value = strFormula
oAccount.Offset(0, rngFormulaDest.Column -
rngLookupAccounts.Column).Value = strFormula
End If
strFormula = ""
Next
'
Application.ScreenUpdating = True
Application.StatusBar = False
MsgBox ("Downfoot creation complete!")
End Sub