cellRange

[PeteM5]

I can't get cellRange to work.
I've tried adding a background color to the cell and now changing the font.
Run this in Solidworks.

' Steg 4: Infoga tom rad och lägg till formel i G
   startRow = lastRow ' Start at the end
    For i = lastRow To 2 Step -1
        ' Kontrollera om värdet i kolumn C ändras
        If ws.Cells(i, 3).Value <> ws.Cells(i - 1, 3).Value Then
            ' Hämta värdet från kolumn C innan tom rad infogas
            currentValue = ws.Cells(i, 3).Value
   
            ' Infoga en tom rad
            ws.Rows(i).Insert Shift:=xlDown
   
           ' Skapa formel på den tomma raden i G (kolumn 7)
sumRange = "E" & startRow + 1 & ":E" & i + 1
ws.Cells(i + 1, 7).Formula = "=ROUNDUP(SUM(" & sumRange & ") / 6000, 0)"

' Sätt värdet i H-kolumnen (kolumn 8) till samma som i C-kolumnen på den nya tomma raden
ws.Cells(i + 1, 8).Value = currentValue  ' H = C på samma rad

' Gör texten fet och större i både G och H
Dim cellRange As Range
Set cellRange = ws.Range(ws.Cells(i + 1, 7), ws.Cells(i + 1, 8))

With cellRange
    .Interior.Color = RGB(144, 238, 144) ' Ljusgrön färg
    .Font.Bold = True  ' Fet text
    .Font.Size = 12  ' Större textstorlek (ändra vid behov)
    With .Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
End With

 

[saboh12617]

Hello,

The code "looks correct" but it is incomplete. Most of all i do not see the "Next i" statement closing your for loop, and not End to your If statement. Are you sure the "i" used for the definition of the range address is correct?

To me, the problem is more that the range is defined somewhere else than you expect, rather than "code not working", because the syntax regarding the cellRange is correct.

Run the macro step by step with F8 and double check the address of your cellRange variable once it is initialized.

 

[PeteM5]

The code before..

' Sub för att bearbeta Excel-filen efter export
Sub ProcessExcelFile(FilePath As String)
    Dim xlApp As Object
    Dim xlWorkbook As Object
    Dim ws As Object
    Dim lastRow As Long
    Dim i As Long
    Dim startRow As Long
    Dim sumRange As String
    Dim currentValue As String

    ' Starta Excel
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = False
    Set xlWorkbook = xlApp.Workbooks.Open(FilePath)
    Set ws = xlWorkbook.Sheets(1)

    ' Hitta sista använda raden i kolumn C
    lastRow = ws.Cells(ws.Rows.Count, 3).End(-4162).row ' xlUp = -4162

    ' Lägg till rubriker i rad 1
    ws.Cells(1, 1).Value = "DET."
    ws.Cells(1, 2).Value = "ANT."
    ws.Cells(1, 3).Value = "BENÄMNING"
    ws.Cells(1, 4).Value = "LÄNGD"
    ws.Cells(1, 5).Value = "TOTAL LÄNGD"
    ws.Cells(1, 6).Value = "ACKUMULERAD"
    ws.Cells(1, 7).Value = "ANTAL HELLÄNGDER"
    ws.Cells(1, 8).Value = "STORLEK"

    ' Steg 1: Fyll i kolumn E (E = D * B)
    For i = 2 To lastRow
        ws.Cells(i, 5).Value = ws.Cells(i, 4).Value * ws.Cells(i, 2).Value
    Next i

    ' Steg 2: Fyll i kolumn F (ACKUMULERAD)
    ws.Cells(2, 6).Value = ws.Cells(2, 5).Value
    For i = 3 To lastRow
        ws.Cells(i, 6).Value = ws.Cells(i - 1, 6).Value + ws.Cells(i, 5).Value
    Next i

    ' Steg 3: Sortera kolumn C från A till Ö
    ws.Sort.SortFields.Clear
    ws.Range("A1:H" & lastRow).Sort Key1:=ws.Range("C2"), Order1:=1, Header:=1 ' xlAscending = 1
    ws.Sort.SetRange ws.Range("A2:H" & lastRow)
    ws.Sort.Header = xlNo
    ws.Sort.Apply

    ' Steg 4: Infoga tom rad och lägg till formel i G
   startRow = lastRow ' Start at the end
    For i = lastRow To 2 Step -1
        ' Kontrollera om värdet i kolumn C ändras
        If ws.Cells(i, 3).Value <> ws.Cells(i - 1, 3).Value Then
            ' Hämta värdet från kolumn C innan tom rad infogas
            currentValue = ws.Cells(i, 3).Value
   
            ' Infoga en tom rad
            ws.Rows(i).Insert Shift:=xlDown
   
           ' Skapa formel på den tomma raden i G (kolumn 7)
            sumRange = "E" & startRow + 1 & ":E" & i + 1
            ws.Cells(i + 1, 7).Formula = "=ROUNDUP(SUM(" & sumRange & ") / 6000, 0)"
            
              ' Sätt värdet i H-kolumnen (kolumn 7) till samma som i C-kolumnen på den nya tomma raden
            ws.Cells(i + 1, 8).Value = currentValue  ' H = C på samma rad
            
                      
            ' Uppdatera startRow för nästa sektion
            startRow = i - 1
        End If
    Next i

    ' Anpassa kolumnbredden
    ws.Cells.EntireColumn.AutoFit

    ' Spara och stäng filen
    xlWorkbook.Save
    xlWorkbook.Close False
    xlApp.Quit

    ' Rensa minnet
    Set ws = Nothing
    Set xlWorkbook = Nothing
    Set xlApp = Nothing
End Sub