VBA Excel range offset

Question

I've got this:

Public Function Gegevens_Ophalen(ByVal ParameterRow As Integer, ByVal KolomLetterSOM As String, ByVal sheetname As String, ByVal Rij As Integer) As Single

Dim WB1 As Workbook
Dim WB2 As Workbook
Dim WS As Worksheet
Dim Filter As Object
Set Filter = CreateObject("scripting.dictionary")
Set Eenheden = CreateObject("scripting.dictionary")
Set Processen = CreateObject("scripting.dictionary")
Set Looptijd = CreateObject("scripting.dictionary")
Set WB1 = Workbooks("KOW.xlsm")
Set WB2 = ActiveWorkbook
Set WS = WB2.Sheets("Page1_1")
Debug.Print ("Start: " & Now())
Dim Eenheid As String
Dim Medewerker_Kolom As String
Dim RN As Single: RN = 10
Dim PR As Single: PR = 0
Dim som As Single: som = 0

Do Until ThisWorkbook.Sheets(sheetname).Range("B" & ParameterRow + PR).Value = ""
    If (ThisWorkbook.Sheets(sheetname).Range("B" & ParameterRow + PR).Value = "Kolom H (eenheid) =") Then
        Eenheden(LCase(ThisWorkbook.Sheets(sheetname).Range("C" & ParameterRow + PR).Value)) = "filteren"
        Debug.Print (LCase(ThisWorkbook.Sheets(sheetname).Range("C" & ParameterRow + PR).Value))
    ElseIf (ThisWorkbook.Sheets(sheetname).Range("B" & ParameterRow + PR).Value = "Kolom K (naam Medew) =") Then
        Filter(LCase(ThisWorkbook.Sheets(sheetname).Range("C" & ParameterRow + PR).Value)) = "filteren"
        Debug.Print (LCase(ThisWorkbook.Sheets(sheetname).Range("C" & ParameterRow + PR).Value))
    ElseIf (ThisWorkbook.Sheets(sheetname).Range("B" & ParameterRow + PR).Value = "Kolom D (proces) = ") Then
        Processen(LCase(ThisWorkbook.Sheets(sheetname).Range("C" & ParameterRow + PR).Value)) = "filteren"
        Debug.Print (LCase(ThisWorkbook.Sheets(sheetname).Range("C" & ParameterRow + PR).Value))
    ElseIf (ThisWorkbook.Sheets(sheetname).Range("B" & ParameterRow + PR).Value = "Kolom Y (looptijdcat) =") Then
        Looptijd(LCase(ThisWorkbook.Sheets(sheetname).Range("C" & ParameterRow + PR).Value)) = "filteren"
        Debug.Print (LCase(ThisWorkbook.Sheets(sheetname).Range("C" & ParameterRow + PR).Value))
    Else
        '
    End If
    PR = PR + 1
Loop

Eenheid = ThisWorkbook.Sheets(sheetname).Range("C" & ParameterRow).Value

Do Until WS.Range("A" & RN).Value = ""
    If sheetname <> "Kleiner10" Or sheetname <> "10-30" Or sheetname <> "Groter30" Or sheetname <> "Doelen" Then
        If (Eenheden(LCase(WS.Range("H" & RN).Value)) = "filteren") Then
            If (Filter(LCase(WS.Range("K" & RN).Value)) = "filteren" Or Processen(LCase(WS.Range("D" & RN).Value)) = "filteren") Then
                ' niks doen
            Else
                som = som + Sheets("Page1_1").Range(KolomLetterSOM & RN).Value
            End If
        End If
    ElseIf sheetname = "Doelen" Then
        If (Eenheden(LCase(WS.Range("H" & RN).Value)) = "filteren") And (Processen(LCase(WS.Range("Y" & RN).Value)) = "filteren") Then
            som = som + Sheets("Page1_1").Range(KolomLetterSOM & RN).Value
        End If
    ElseIf (Eenheden(LCase(WS.Range("H" & RN).Value)) = "filteren") And (Looptijd(LCase(WS.Range("Y" & RN).Value)) = "filteren") Then 'Doorlooptijden
            If (Filter(LCase(WS.Range("K" & RN).Value)) = "filteren" Or Processen(LCase(WS.Range("D" & RN).Value)) = "filteren") Then
                ' niks doen
            Else
                som = som + Sheets("Page1_1").Range(KolomLetterSOM & RN).Value
            End If
    End If
    RN = RN + 1
Loop

Debug.Print ("Eind: " & Now())
Bulk_Voorraad = som
Debug.Print som

' range offset

End Function

What I now need is that at the 'range offset I need to place values back into excel in the current weeknumber minus 1. If it is week 16 for example my values need to be placed in the right week. With the parameter Rij I give the value of the rowoffset for the right week. I tried a lot but nothing that works.

This is how I call the function: Call Gegevens_Ophalen(2, "W", "ProductieUren", 1).

I searched all over the internet but couldn' t really find anything that comes close. I found this link but couldn't really fit it into my own code: https://www.rondebruin.nl/win/s9/win006.htm.

Has anybody some ideas or some tips to help me?

Could you briefly explain what your code does already. Also you should use Set ws = ThisWorkbook.Worksheets(sheetname) and use a with ws to make your code more readable. — Plagon
– Plagon, Commented May 18, 2017 at 19:47
My code already loops through different sheets for getting the value that needs to be placed right back into excel. With debug.print I checked and got the right values. Thanks for the tip to make the code more readable. I will change it into my real code. — EfhK
– EfhK, Commented May 18, 2017 at 19:51

Plagon · Accepted Answer · 2017-05-18 20:05:09Z

1

If i understood you correctly you just need a way to get the offset for the current week. This Macro takes a value and paste it in the column for the current week. Try it out and modify it for your Workbook.

Sub InsertValues()
Dim Start, i, Value As Integer
Start = 2 'Start Columns(First Week) (i.e "B" for Week 1)
CKW = DINKw(Date)
i = 2
Value = 2
ThisWorkbook.Worksheets("Tabelle1").Cells(i, Start + CKW - 1).Value = Value 'Paste Value in current Week 'i = row 'Value = Your Value
End Sub

Function DINKw(Datum As Date) As Integer
Dim lngT As Long
   lngT = DateSerial(Year(Datum + (8 - Weekday(Datum)) Mod 7 - 3), 1, 1)
   DINKw = ((Datum - lngT - 3 + (Weekday(lngT) + 1) Mod 7)) \ 7 + 1
End Function

answered May 18, 2017 at 20:05

Plagon

3,1651 gold badge14 silver badges27 bronze badges

Sign up to request clarification or add additional context in comments.

1 Comment

EfhK Over a year ago

Thank you so much! I first thought it couldn't be right but after trying it out and modifying it, it works perfectly!

Collectives™ on Stack Overflow

VBA Excel range offset

1 Answer 1

1 Comment

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

1 Comment

Your Answer

Sign up or log in

Post as a guest

Related