Is there a way to reassign a Range variable to a different range? - excel

I am very new to VBA, having started programming it yesterday. I am writing a data processing program which requires keeping track of two cells, one on each spreadsheet. The code which reproduces the errors I am experiencing is below. When I call the sub moveCell() in sub Processor(), nothing happens to DIRow and DIColumn, and the code spits out error 1004 at the line indicated. I have tried using DICell = DICell.Offset(), but it returns the same error.
How can I redefine a Range variable to be a different cell?
'<<Main Processor Code>>'
Sub Processor()
Dim PDRow As Integer
Dim PDColumn As Integer
Dim DIRow As Integer
Dim DIColumn As Integer
PDRow = 1
PDColumn = 1
DIRow = 1
DIColumn = 1
Dim PDCell As Range
Dim DICell As Range
Set PDCell = Worksheets("Processed Data").Cells(PDRow, PDColumn)
Set DICell = Worksheets("Data Input").Cells(DIRow, DIColumn)
Call moveCell(2, 0, "Data Input")
End Sub
'<<Function which moves the cell which defines the range>>'
Sub moveCell(r As Integer, c As Integer, sheet As String)
If sheet = "Processed Data" Then
PDRow = PDRow + r
PDColumn = PDColumn + c
Set PDCell = Worksheets("Data Input").Cells(PDRow, PDColumn)
ElseIf sheet = "Data Input" Then
DIRow = DIRow + r '<<<<<<This line does nothing to DIRow's value
DIColumn = DIColumn + c
Set DICell = Worksheets("Data Input").Cells(DIRow, DIColumn) '<<<<<<This line causes error 1004
End If
End Sub

As far as I can tell, you could instead use a quick Function instead. There doesn't seem to be any difference in your If statement results in the moveCell() function, except which worksheet you're using.
We can make this simpler by referring to the Range you're passing to moveCell.
Option Explicit ' forces you to declare all variables
Sub something()
Dim PDCell As Range
Set PDCell = Worksheets("Processed Data").Cells(1, 1)
Dim DICell As Range
Set DICell = Worksheets("Data Input").Cells(1, 1)
PDCell.Select ' can remove
Set PDCell = moveCell(2, 0, PDCell, PDCell.Worksheet.Name)
PDCell.Select ' can remove
Worksheets(DICell.Worksheet.Name).Activate ' can remove
DICell.Select ' can remove
Set DICell = moveCell(5, 0, DICell, DICell.Worksheet.Name)
DICell.Select ' can remove
End Sub
Function moveCell(rowsToMove As Long, colsToMove As Long, cel As Range, ws As String) As Range
Set moveCell = Worksheets(ws).Cells(cel.Row + rowsToMove, cel.Column + colsToMove)
End Function
I've included some rows you don't need (which I've marked with a comment afterwards), but that will show you how the routine works. You can step through with F8 to help see it step-by-step.
Edit: Although, you don't need a separate function at all. Just use OFFSET().
Set PDCell = ...whatever originally
Set PDCell = PDCell.Offset([rows],[cols])

Related

converting Excel array formula to VBA code

Hello Everyone
I've got this array formula in excel and I want to merge it in a VBA code but it gives me an error of Unable to set the FormulaArray property of the Range class (Error 1004)
Here is the formula after i ammended it in the code
"=IF(SUMPRODUCT(--(($D$2=$B9)*(E$7>=$D$3)*(E$7<=$D$4)*(NOT(E$6>=1))*(NOT(E$8='الجمعة'))))=1;VLOOKUP($D$5;LeavesTypes;2;0);"""")"
and here is the full code
Option Explicit
Option Base 1
Dim wrk As Workbook, DataSH As Worksheet, CurrentSH As Worksheet
Dim FirstCol As Integer, EmpRow As Integer, EmpID As String
Dim GetEmpRowLoop As Integer, StartingEmpCol As Integer
Dim StartColLoop As Integer, EndingEmpCol As Integer
Dim EndColLoop As Integer
Public Sub Macro1()
Set wrk = ThisWorkbook
Set DataSH = wrk.Worksheets("الاجازات ")
Set CurrentSH = wrk.ActiveSheet
If CurrentSH.Name = DataSH.Name Then
MsgBox "Please Navigate to an Active Sheet", vbCritical
Exit Sub
End If
EmpID = CurrentSH.Range("d2").Value
For GetEmpRowLoop = 9 To CurrentSH.Cells(Cells.Rows.Count, 2).End(xlUp).Row
If CurrentSH.Cells(GetEmpRowLoop, 2).Value = EmpID Then
EmpRow = GetEmpRowLoop
Exit For
End If
Next GetEmpRowLoop
For StartColLoop = 4 To CurrentSH.Cells(EmpRow, Cells.Columns.Count).End(xlToRight).Column
If CurrentSH.Cells(7, StartColLoop).Value = CurrentSH.Range("D3").Value Then
StartingEmpCol = StartColLoop
Exit For
End If
Next StartColLoop
For EndColLoop = 4 To CurrentSH.Cells(EmpRow, Cells.Columns.Count).End(xlToRight).Column
If CurrentSH.Cells(7, EndColLoop).Value = CurrentSH.Range("D4").Value Then
EndingEmpCol = EndColLoop
Exit For
End If
Next EndColLoop
CurrentSH.Range(Cells(EmpRow, StartingEmpCol), Cells(EmpRow, StartingEmpCol)).FormulaArray = _
"=IF(SUMPRODUCT(--(($D$2=$B9)*(E$7>=$D$3)*(E$7<=$D$4)*(NOT(E$6>=1))*(NOT(E$8='الجمعة'))))=1;VLOOKUP($D$5;LeavesTypes;2;0);"""")"
End Sub
I'm trying to place whether the formula itself or the result doesn't matter.
You'll need to replace the single quotes (') with double quotes (""). However, you'll need to double up on the quotes...
(NOT(E$8=""الجمعة""))
By the way, there's no need for SUMPRODUCT. The following should suffice...
.Formula = "=IF(($D$2=$B9)*(E$7>=$D$3)*(E$7<=$D$4)*(NOT(E$6>=1))*(NOT(E$8=""الجمعة""))=1;VLOOKUP($D$5;LeavesTypes;2;0);"""")"

Cut Range of Cells from one sheet to another

I'm simply trying to "Cut" a range of cells from one sheet to another. I've never been able to make the ".Cut" work but the ".Copy" works with an error ("Run-time error '424': Object required"). I don't understand why ".Cut" doesn't work as simple as ".Copy" and what the error is.
Private Sub mti_line62_Click()
Dim infreq As Worksheet
Dim freq As Worksheet
Dim mti_player As Range
Dim line62 As Range
Set infreq = ThisWorkbook.Worksheets("INFREQ")
Set freq = ThisWorkbook.Worksheets("Frequent")
Set mti_player = infreq.Range("D" & Rows.Count).End(xlUp).Offset(1)
Set line62 = freq.Range("D62:Q62")
mti_player.PasteSpecial = freq.Range("D62:Q62").Copy
'mti_player.PasteSpecial = freq.Range("D62:Q62").Cut
'mti_player.PasteSpecial = line62.Copy
'freq.Range("D62:Q62").Clear
Application.CutCopyMode = False
infreq.Activate
End Sub

Still Run time error 1004 'Unable to get the VLookup property of the WorksheetFunction class

I got this error and I tried to fixed with many solution, but I don't know why this error is happening. Could you help me to fix this problem? In this code I have twice used VLookup function same source, different only Worksheet name and column. Another one can compile this code and don't have any error.
I'm doing, VLookup item on column B of worksheet "ImportData2" match with column A of worksheet "Noallocate" if match show result of VLookup at column Q of worksheet "ImportData2"
get this error
Source code:
'Vlook up function no import
Dim Vrow1 As Long
Dim myLookupValue1 As String
Dim myFirstColumn1 As Long
Dim myLastColumn1 As Long
Dim myColumnIndex1 As Long
Dim myFirstRow1 As Long
Dim myLastRow1 As Long
Dim myVLookupResult1 As String
Dim myTableArray1 As Range
For Vrow1 = 2 To 99999
myLookupValue1 = Workbooks("ExpenseData.xlsm").Worksheets("ImportData2").Range("B" & Vrow).Value
myFirstColumn1 = 1
myLastColumn1 = 2
myColumnIndex1 = 2
myFirstRow1 = 2
myLastRow1 = Workbooks("ExpenseData.xlsm").Worksheets("Noallocate").Range("b1").End(xlDown).Row
With Workbooks("ExpenseData.xlsm").Worksheets("Noallocate")
Set myTableArray1 = .Range(.Cells(myFirstRow1, myFirstColumn1), .Cells(myLastRow1, myLastColumn1))
End With
myVLookupResult1 = WorksheetFunction.VLookup(myLookupValue1, myTableArray1, myColumnIndex1, False) 'xxx
Workbooks("ExpenseData.xlsm").Worksheets("ImportData").Range("Q" & Vrow).Value = myVLookupResult1 'xxx
Next 'end function no import
Try the next code, please. It would be a good habit to have 'Option Explicit' on top of your module. This will oblige you to declare all variables. It looks, your code iterates using Vrow1 but inside the loop you used Vrow... I discovered it only after trying to make your code a little friendlier. It is not good to use big variables name instead of 1, 2. This can only make the code more difficult to be understood by looking at it. As short it would be, as easy to be understood and debugged:
Sub testVlookup()
Dim Wb As Workbook, Vrow1 As Long, lastRDat As Long, wsNoall As Worksheet
Dim wsImpD2 As Worksheet, myLookupValue1 As String, myLastRow1 As Long
Dim myVLookupResult1 As String, myTableArray1 As Range
Set Wb = Workbooks("ExpenseDataMcframe.xlsm")
Set wsNoall = Wb.Worksheets("Noallocate")
Set wsImpD2 = Wb.Worksheets("ImportData2")
myLastRow1 = wsNoall.Range("b" & Rows.count).End(xlUp).Row
lastRDat = wsImpD2.Range("B" & Rows.count).End(xlUp).Row
For Vrow1 = 2 To lastRDat
myLookupValue1 = wsImpD2.Range("B" & Vrow1).value
Set myTableArray1 = wsNoall.Range(wsNoall.Cells(2, 1), wsNoall.Cells(myLastRow1, 2))
On Error Resume Next 'for the case when lookup_value is not found
myVLookupResult1 = WorksheetFunction.VLookup(myLookupValue1, myTableArray1, 2, False) 'xxx
If Err.Number <> 0 Then
Err.Clear: On Error GoTo 0
Wb.Worksheets("ImportData").Range("Q" & Vrow1).value = "Not a mach"
Else
Wb.Worksheets("ImportData").Range("Q" & Vrow1).value = myVLookupResult1 'xxx
End If
On Error GoTo 0
Next
End Sub
When the lookup_value is not found, the code will return (on Q:Q column) "Not a match" and you must check the specific code/whatever it is...

VBA code working when I step through it, but not when it's run

I have some basic VBA that is allowing a user to take a field from one table and use it to update another table. It works fine when I step through it, but nothing happens when I run it using F5. I don't get any errors, just nothing happens.
I think it could possibly be that the value hasn't been assigned to one of the variables before the next step occurs, but I've never had that problem before, and I've always assumed VBA wouldn't move to the next step until it had completed the one it's on?
My code is below:
Option Explicit
Sub acceptDateComp()
'set data type
Dim dtType As String
dtType = "opportunity"
'declare sheets
Dim wsComp As Worksheet
Set wsComp = ThisWorkbook.Sheets(dtType & "Comp")
Dim wsBCE As Worksheet
Set wsBCE = ThisWorkbook.Sheets(dtType & "Snapshot")
Dim wsOffline As Worksheet
Set wsOffline = ThisWorkbook.Sheets(dtType & "Database")
'declare tables
Dim bce As ListObject
Set bce = wsBCE.ListObjects(dtType & "Snapshot")
Dim offline As ListObject
Set offline = wsOffline.ListObjects(dtType & "Database")
Dim dateComp As ListObject
Set dateComp = wsComp.ListObjects(dtType & "DateComp")
'declare heights and areas
Dim offlineRange As Range
Set offlineRange = offline.ListColumns(1).DataBodyRange
'check for acceptance, then change values
Dim i As Long
Dim dateID As Long
Dim offlineRow As Long
Dim bceDate As String
For i = 2 To dateComp.ListRows.Count + 1
If dateComp.ListColumns(6).Range(i).Value = "Yes" Then
dateID = dateComp.ListColumns(1).Range(i).Value
offlineRow = Application.WorksheetFunction.Match(dateID, offlineRange, 0)
bceDate = dateComp.ListRows(i - 1).Range(5).Value
offline.ListRows(offlineRow).Range(12).Value = bceDate
End If
Next i
Call opportunityComp
End Sub

Sum using Index vba excel

Can someone tell me the correct syntax for this code I am trying to execute? From a 1D range of string values, I want to pick a certain string say "this" and calculate the sum of all the values of "this" which are displayed in the immediate next column. It's been eating my head up for hours. And also, is there another better way to do it?
With Application.WorksheetFunction
Range("AA2").Value = .Sum(.Index(ws(1).Range("F8"), .Match(ws(1).Range("AA1"), ws(1).Range("E8:E16"), 0), 0) **:** .index(ws(1).Range("F16"), .Match(ws(1).Range("AA1"), ws(1).Range("E8:E16"), 0), 0)
End With
In excel it would be:
=SUMIF(E8:E16,"=this",F8:F16)
So in your macro try:
Option Explicit
Public Sub StackOverflowDemo()
Dim conditionText As String
Dim ws As Worksheet
Dim target As Range
Dim sourceCriteria As Range
Dim sourceSum As Range
Set ws = ThisWorkbook.Sheets(1)
conditionText = "this"
Set target = ws.Range("AA2")
Set sourceCriteria = ws.Range("E8:E16")
'the above stuff would probably be passed as parameters since I doubt you want that stuff hard coded
'from here on there's no hard coding.
Set sourceSum = sourceCriteria.Offset(0, 1)
target.Value = WorksheetFunction.SumIf(sourceCriteria, "=" & conditionText, sourceSum)
End Sub
Update: Refactored to show the reusability / benefit of using variables:
Option Explicit
Public Sub StackOverflowDemo()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(1)
DoSumIf ws.Range("E8:E16"), "this", ws.Range("AA2")
DoSumIf ws.Range("E8:E16"), "that", ws.Range("AA3")
DoSumIf ws.Range("B2:B32"), "who", ws.Range("AA4")
End Sub
Private Sub DoSumIf(sourceCriteria As Range, conditionText As String, target As Range)
Dim sourceSum As Range
Set sourceSum = sourceCriteria.Offset(0, 1)
target.Value = WorksheetFunction.SumIf(sourceCriteria, "=" & conditionText, sourceSum)
End Sub
You can do it in VBA using something to this effect:
This will search E2:E300 for the string "P09" and sum the column directly to the right.
Sub Test123455()
Dim MyRange As Range
Set MyRange = Nothing
Dim curcell As Range
For Each curcell In Range("E2:E300")
If InStr(1, curcell.Value, "P09", vbTextCompare) > 0 Then
If MyRange Is Nothing Then
Set MyRange = curcell
Else
Set MyRange = Union(MyRange, curcell.Offset(0, 1))
End If
End If
Next curcell
MsgBox Application.WorksheetFunction.Sum(MyRange)
End Sub

Resources