Input range cell & coloum macro

  1. 5 bulan yang lalu

    Dear Suhu master....
    Mohon dapat dibantu merubah script dibawah ini ditambahkan inputbox, saya coba merubah dengan application.inputbox tetapi ngk bisa fungsi yah.... yang bagian ini:

    lrow = sh.Range("I" & Rows.Count).End(xlUp).Row
    Set Vol = sh.Range("I8:I" & lrow)

    yang mau diambil input "I" dan "I8:I"

    terima kasih atas bantuannya

    Script lengkapnya ;
    Sub insertrumus1()
    On Error Resume Next
    If Not Application.ActiveWorkbook Is Nothing Then
    Dim xlSheet As Worksheet
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    For Each xlSheet In ActiveWorkbook.Worksheets
    If xlSheet.Name <> "MASTER" And xlSheet.Name <> "SAMPLE" Then
    If Application.WorksheetFunction.CountBlank(xlSheet.Range("A1:A")) < 1 Then
    xlSheet.Columns("A:F").Insert Shift:=xlToRight
    End If
    End If
    Next xlSheet

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    End If

    Err.Clear
    On Error GoTo 0

    Dim sh As Worksheet
    Dim Vol As Range, sel As Range

    On Error Resume Next
    For Each sh In ActiveWorkbook.Worksheets
    If sh.Name <> "MASTER" And sh.Name <> "SAMPLE" Then
    lrow = sh.Range("I" & Rows.Count).End(xlUp).Row
    Set Vol = sh.Range("I8:I" & lrow)
    For Each sel In Vol
    If IsNumeric(sel) And sel > 0 And sel.Offset(0, 2) = "" Then
    sh.Cells(sel.Row, 1) = "BSMED"
    sh.Cells(sel.Row, 2) = "=A" & sel.Row & "&F" & sel.Row & ""
    sh.Cells(sel.Row, 4) = "1"
    sh.Cells(sel.Row, 6) = "100"
    sh.Cells(sel.Row, 11) = "=VLOOKUP(B" & sel.Row & ",MASTER,5,0)*D" & sel.Row & ""
    sh.Cells(sel.Row, 12) = "=K" & sel.Row & "*I" & sel.Row & ""
    sh.Cells(sel.Row, 13) = "=VLOOKUP(B" & sel.Row & ",MASTER,10,0)*D" & sel.Row & ""
    sh.Cells(sel.Row, 14) = "=M" & sel.Row & "*I" & sel.Row & ""
    End If

    Next sel
    End If
    Next sh
    Application.Calculation = xlCalculationAutomatic
    End Sub

  2. manweljs_

    Jul 25 Terverifikasi + 6.199 Poin
    Di sunting 5 bulan yang lalu oleh manweljs_

    @nafis2006

    coba deklarasikan vol sebagai variant kemudian set vol sebagai inputbox :

    ...
    Dim vol as variant
    ...
    vol = application.inputBox("pesan disini", Type:=8).Address
    ...

    belum saya coba, tapi seharusnya bisa. dan usahakan set inputboxnya sebelum Screen Updating nya di false ya

  3. Mas @manweljs_ ....
    Ambil nama coloum "I" saja bisa yah...... bukanNya kalau saya tekan di worksheet menjadi alamat cell "I5".

    dan saya ada insert columns sebelumnya berarti saya harus +6 columns yah...
    xlSheet.Columns("A:F").Insert Shift:=xlToRight

    terima kasih sebelumnya.....

  4. manweljs_

    Jul 25 Terverifikasi + 6.199 Poin
    Di sunting 5 bulan yang lalu oleh manweljs_

    @nafis2006

    coba dilampirkan contoh file yang sedang dikerjakan, lewat PM juga boleh. saya betul2 tidak paham postingan terakhir anda diatas.

    bukankan anda menginginkan nilai range dari "vol" ditentukan melalui sebuah input box ? jika memang demikian metode untuk last row tidak diperlukan lagi, anda cukup memblok range yang anda inginkan. dan untuk insert kolom seharusnya tidak berpengaruh karena input box akan muncul setelah skrip untuk insert kolom telah selesai dijalankan.

    saran saya sebaiknya anda membuat 2 sub misalnya sub pertama IsiKolom dan isiRumus namun cukup menjalankan 1 saja :

    Sub isiKolom()
    On Error Resume Next
    If Not Application.ActiveWorkbook Is Nothing Then
    Dim xlSheet As Worksheet
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    For Each xlSheet In ActiveWorkbook.Worksheets
        If xlSheet.Name <> "MASTER" And xlSheet.Name <> "SAMPLE" Then
            If Application.WorksheetFunction.CountBlank(xlSheet.Range("A1:A")) < 1 Then
            xlSheet.Columns("A:F").Insert Shift:=xlToRight
            End If
        End If
    Next xlSheet
    End If
    
    Application.ScreenUpdating = True
    Call isiRumus ' <--- isi rumus dijalankan disini
    
    Application.CutCopyMode = False
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    End Sub

    Sub isiRumus()
    Dim sh As Worksheet, Vol As Variant, sel As Range
    
    On Error Resume Next
    For Each sh In ActiveWorkbook.Worksheets
        If sh.Name <> "MASTER" And sh.Name <> "SAMPLE" Then
        sh.Activate
        Vol = Application.InputBox("Tentukan Range VOL", Type:=8).Address
        
        Application.ScreenUpdating = False
            For Each sel In Vol
                If IsNumeric(sel) And sel > 0 And sel.Offset(0, 2) = "" Then
                sh.Cells(sel.Row, 1) = "BSMED"
                sh.Cells(sel.Row, 2) = "=A" & sel.Row & "&F" & sel.Row & ""
                sh.Cells(sel.Row, 4) = "1"
                sh.Cells(sel.Row, 6) = "100"
                sh.Cells(sel.Row, 11) = "=VLOOKUP(B" & sel.Row & ",MASTER,5,0)*D" & sel.Row & ""
                sh.Cells(sel.Row, 12) = "=K" & sel.Row & "*I" & sel.Row & ""
                sh.Cells(sel.Row, 13) = "=VLOOKUP(B" & sel.Row & ",MASTER,10,0)*D" & sel.Row & ""
                sh.Cells(sel.Row, 14) = "=M" & sel.Row & "*I" & sel.Row & ""
                End If
            Next sel
        Application.ScreenUpdating = True
        End If
    Next sh
    End Sub

    catatan : saya hanya menerka2 skrip tersebut, tanpa melihat susunan datanya saya tidak yakin apakah sudah sesuai atau belum dan karena hanya menerka2 maka saya membuat inputbox muncul pada setiap sheet

  5. Dear mas @manweljs_ ......
    Mohon maaf mas mungkin saya kurang bisa menjelaskan......
    Tetapi Koreksi atas script diatas belum sepertinya yang dimaksud dikarenakan inputbox muncul pada setiap sheet.
    sebenarnya dengan menggunakan script

    lrow = sh.Range("I" & Rows.Count).End(xlUp).Row
    Set Vol = sh.Range("I8:I" & lrow)

    sudah sangat cocok range automatis untuk setiap sheet yang ada, bisa membaca sampai row yang aktif.

    hanya saja setiap saya ganti file yg aktif, saya harus rubah dulu macro nya semisal "I" diganti "k"
    dan "I8:I" saya rubah juga menjadi "k10:k", dan ini berlaku untuk semua sheet dalam file tersebut.

    Tadi nya saya pikir mau saya rubah dengan input box. tinggal select cell yang dituju. semisal hasilnya "F8"
    nah huruf F nya saja saya masukan ke "lrow = sh.Range("F" & Rows.Count).End(xlUp).Row"
    dan yang ini otomatis berubah menjadi "Set Vol = sh.Range("F8:F" & lrow)"

    begitu mas @manweljs_ ....

    kalau file nya saya kirim PM ke email yang mana mas...?

    terima kasih banyak atas bantuannya... mohon maaf banyak tanya2...takut nyasar mas

  6. manweljs_

    Jul 26 Terverifikasi + 6.199 Poin
    Di sunting 5 bulan yang lalu oleh manweljs_

    @nafis2006

    saya kasih contoh dari file sebelumnya aja ya (terlampir), silahkan dimodifikasi sesuai kebutuhan

    jalankan makro runProcess

    kalau file nya saya kirim PM ke email yang mana mas...?

    caranya buat diskusi baru kemudian pilih ID user yang bisa melihat diskusi tersebut seperti gambar ini:

    Capture.PNG

  7. Terima kasih banyak mas @manweljs_ .....
    atas ilmunya..... sudah bisa saya kembangkan......

    met sukses selalu....

 

atau Mendaftar untuk ikut berdiskusi!