Results 1 to 11 of 11
  1. #1
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Recopy do until change (2000 sr 1)

    in column F is present a value and it change when the value change in the column E
    My problem is to recopy the same value for each value present in column E do until change the next...
    Final result is in the sheet FINAL of the wbook (naturally extended the macro do until 65536...)

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 28 Times in 28 Posts

    Re: Recopy do until change (2000 sr 1)

    Here is a macro to do that:

    Sub FillGaps()
    Dim lngMaxRow As Long
    Dim lngRowIndex As Long
    lngMaxRow = Range("E65536").End(xlUp).Row
    For lngRowIndex = 2 To lngMaxRow
    If Trim(Range("F" & lngRowIndex)) = "" Then
    Range("F" & lngRowIndex) = Range("F" & (lngRowIndex - 1))
    End If
    Next lngRowIndex
    End Sub

  3. #3
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Recopy do until change (2000 sr 1)

    GOOD AND TKS!, Naturally you have understand me....

  4. #4
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Recopy do until change (2000 sr 1)

    Hans,
    I do not succeed to import the value TOTALE and to add under every recod refred column J, M, N and O i attach a simple txt file...
    Accccccccccccccccccccc...

    My macro for import:

    Sub FATTURE()

    Dim riga As String
    Dim cont As Double

    cont = 2

    Dim Vfile
    Vfile = Application.GetOpenFilename

    Open Vfile For Input As #1

    While Not EOF(1)
    Line Input #1, riga

    FASE = 0
    If Len(Trim(riga)) > 0 Then

    If InStr(Mid(riga, 6, 7), "Settore") > 0 Then
    var_sett = Mid(riga, 14, 2)
    FASE = 1
    End If

    If InStr(Mid(riga, 6, 7), "Cliente") > 0 Then
    var_cliente = Trim(Mid(riga, 14, 35))
    var_cope = Mid(riga, 57, 9)
    var_ggdisp = Trim(Mid(riga, 110, 3))
    FASE = 2
    End If

    If InStr(Mid(riga, 6, 15), "Conto ordinario") > 0 Then
    var_c_ord = Mid(riga, 22, 6)
    var_dip = Mid(riga, 41, 4)
    FASE = 3
    End If

    If InStr(Mid(riga, 32, 1), "/") > 0 Then
    var_c_spec = Mid(riga, 6, 6)
    var_scadfatt = Mid(riga, 13, 10)
    var_nfatt = Trim(Mid(riga, 24, 8))
    var_ant = Trim(Mid(riga, 33, 3))
    var_imp = Trim(Mid(riga, 37, 12))
    var_datant = Mid(riga, 50, 10)
    var_deb = Trim(Mid(riga, 61, 23))
    var_totfatt = Trim(Mid(riga, 85, 12))
    var_totinc = Trim(Mid(riga, 99, 12))
    var_antres = Trim(Mid(riga, 113, 12))
    FASE = 4
    End If

    If FASE = 4 Then
    Foglio2.Range("A" & Trim(Str(cont))).Value = var_sett
    Foglio2.Range("B" & Trim(Str(cont))).Value = var_cope
    Foglio2.Range("C" & Trim(Str(cont))).Value = var_dip
    Foglio2.Range("D" & Trim(Str(cont))).Value = var_c_ord
    Foglio2.Range("E" & Trim(Str(cont))).Value = var_cliente
    Foglio2.Range("F" & Trim(Str(cont))).Value = var_c_spec
    Foglio2.Range("G" & Trim(Str(cont))).Value = var_scadfatt
    Foglio2.Range("H" & Trim(Str(cont))).Value = var_nfatt
    Foglio2.Range("I" & Trim(Str(cont))).Value = var_ant
    Foglio2.Range("J" & Trim(Str(cont))).Value = var_imp
    Foglio2.Range("K" & Trim(Str(cont))).Value = var_datant
    Foglio2.Range("L" & Trim(Str(cont))).Value = var_deb
    Foglio2.Range("M" & Trim(Str(cont))).Value = var_totfatt
    Foglio2.Range("N" & Trim(Str(cont))).Value = var_totinc
    Foglio2.Range("O" & Trim(Str(cont))).Value = var_antres
    Foglio2.Range("P" & Trim(Str(cont))).Value = var_ggdisp

    cont = cont + 1
    FASE = 0
    End If
    End If
    Wend

    Close #1

    Range("A2").Select

    MsgBox ("IMPORTAZIONE TERMINATA!")
    End Sub

  5. #5
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 28 Times in 28 Posts

    Re: Recopy do until change (2000 sr 1)

    The text file in the zip file you attached cannot be imported directly into Excel, so I don't know what to do with it.

  6. #6
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Recopy do until change (2000 sr 1)

    i have modify my last msg with the macro import...
    If is possible to insert in the bottom of value only the string of text or summ automatcly with a macro for me is the same select the easly way for you, tks....
    attached example

  7. #7
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 28 Times in 28 Posts

    Re: Recopy do until change (2000 sr 1)

    Sorry, I don't understand. Could you try to explain again?

  8. #8
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Recopy do until change (2000 sr 1)

    OK! If you see my last .xls attach (SHEET final_with_total) i would want to insert in to column J, M, O and P a grand total, and assign the macro at a button: CALCULATE A TOTAL

  9. #9
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 28 Times in 28 Posts

    Re: Recopy do until change (2000 sr 1)

    This was more complicated than I thought. since the columns are formatted as text, so the SUM formula results in 0. Copy the following code into a standard module:

    Sub AddTotals()
    Dim lngRow As Long
    lngRow = Range("E65536").End(xlUp).Row
    AddFormula lngRow, "J"
    AddFormula lngRow, "M"
    AddFormula lngRow, "O"
    AddFormula lngRow, "P"
    End Sub

    Sub AddFormula(lngRow As Long, strCol As String)
    With Range(strCol & "2:" & strCol & (lngRow + 1))
    .NumberFormat = "0.00"
    .HorizontalAlignment = xlGeneral
    .Value = .Value
    End With
    Range(strCol & (lngRow + 1)).Formula = _
    "=SUM(" & strCol & "2:" & strCol & lngRow & ")"
    End Sub

    Assign the AddTotals macro to a button.

  10. #10
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Recopy do until change (2000 sr 1)

    Hi Hans, good morning...
    The macro work fine... and ok for yhis.

    But my prblem is to add for each changemnt block of column E, the total.
    See the attached wbook sheet final_with _total

    example:
    block1
    ASS.NE CIRCUITO TEATRALE REGIONALE
    ASS.NE CIRCUITO TEATRALE REGIONALE
    add total in column , J, M, N and O

    block2
    FONDAZIONE EVANGELICA BETANIA
    FONDAZIONE EVANGELICA BETANIA
    add total in column , J, M, N and O

    .....

    up the grand totale with your macro...


    Good is the last line with the grand total with your last macro.

  11. #11
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 28 Times in 28 Posts

    Re: Recopy do until change (2000 sr 1)

    You can use the Subtotal feature for this:

    Sub AddTotals()
    Dim lngRow As Long
    lngRow = Range("E65536").End(xlUp).Row
    FixColumn lngRow, "J"
    FixColumn lngRow, "M"
    FixColumn lngRow, "O"
    Range("A1").Subtotal GroupBy:=5, Function:=xlSum, _
    TotalList:=Array(10, 13, 15, 16), Replace:=True
    End Sub

    Sub FixColumn(lngRow As Long, strCol As String)
    With Range(strCol & "2:" & strCol & (lngRow + 1))
    .NumberFormat = "#,##0.00"
    .HorizontalAlignment = xlGeneral
    .Value = .Value
    End With
    End Sub

    Again, AddTotals is the macro to be assigned to a command button.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •