Consulting

Results 1 to 6 of 6

Thread: Solved: VBA, checkbox, reporting and sum

  1. #1
    VBAX Regular
    Joined
    Jul 2013
    Posts
    50
    Location

    Question Solved: VBA, checkbox, reporting and sum

    Hello everyone,

    I have a decent understanding of vba but I'm stuck on a problem.

    I have to generate checkbox on a sheet (sheet Result) depending on the value of a cell in another sheet (Sheet Data). So far it's a simple for loop on range.The checkbox are lined up in column A

    I have to assign that value to the caption of the checkbox and add a value from another column of sheet Data along with the caption dynamically in a range further down in Sheet Result if I check the checkbox and remove it if I uncheck it.

    [VBA]Sub AddCheckBoxes()
    On Error Resume Next
    Dim c As Range, myRange As Range
    Set myRange = Range("DataJGO!A2:" & Range("DataJGO!A65536").End(xlUp).Address)

    For Each c In myRange.Cells
    If c.Offset(0, 28) <> "" Then
    ActiveSheet.CheckBoxes.Add(c.Left, c.Top, c.Width, c.Height).Select
    End If
    With Selection
    .Characters.Text = c.Offset(0, 28).Value
    .Name = "Chk" & c.Offset(0, 28).Value
    End With
    c.Select
    Next

    End Sub
    [/VBA]

    it's basically all the code I have for this part. From there I'm stuck, No clue where to begin. I beleive I will have to call a macro on click but still not sure how to assign it when I create them.

    Any bits and pieces of code or advice will help, let me know if you need more info

    Thank you for your time

  2. #2
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location


    I'm gonna have to find a copy of excel 95 so I can really help you guys that want to use the Forms toolbar.

    Although it is the perfect choice in your situation because you can assign one procedure (macro) to many controls.

    This compiles, but I haven't really tested it

    [VBA]Sub AddCheckBoxes()
    On Error Resume Next
    Dim c As Range, myRange As Range
    Dim CbxCell As Range
    Set myRange = Range("DataJGO!A2:" & Range("DataJGO!A65536").End(xlUp).Address)

    For Each c In myRange.Cells
    If c.Offset(0, 28) <> "" Then
    CbxCell = ActiveSheet.Range("A" & c.Row)
    ActiveSheet.CheckBoxes.Add(c.Left, c.Top, c.Width, c.Height).Select
    End If
    With Selection
    .Characters.Text = c.Offset(0, 28).Value
    .Name = CbxCell.Address
    .OnAction = "TestSub"
    End With
    c.Select
    Next

    End Sub

    Sub TestSub()
    Dim CbxName As String
    Dim n As Long
    n = 99 'Offset rows from checkbox to cell to work on. Adjust to suit
    CbxName = Application.Caller.Name
    MsgBox CbxName
    ActiveSheet.Range(CbxName).Offset(n, 0) = "Something"
    End Sub

    [/VBA]
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  3. #3
    VBAX Regular
    Joined
    Jul 2013
    Posts
    50
    Location
    Thank you for your answer,I'll fiddle with this code a bit and will mark it as solved along with the working code when I actually get it working :P

    thanksˇ

  4. #4
    VBAX Regular
    Joined
    Jul 2013
    Posts
    50
    Location
    ok I've messed around quite a bit with it and figured out what I am missing to be able to make it work

    How do I pass the argument to see if I am checking it or unchecking it to the macro that is called? Now I know that the linked cell has the True/False statement but when you click the checkbox the active cell doesn't switch to where the CheckBox is, so no way to get the value of the cell with relative position of the active cell. To make the mater worst I cannot know where exactly the checkbox is since I create multiple.

    I tried to find it on forums, MSDN(yeah right much much info on checkbox there...) most popular answer I found: It's a little too advanced for this forum!

    So if any of you know how to pass the argument from the excel form checkbox to vba or how to get the cell containing the true/false value relative to the checkbox I'll be very gratefull!

    Thank you again for your help

  5. #5
    VBAX Regular
    Joined
    Jul 2013
    Posts
    50
    Location
    I managed to make it work like a charm!

    Here is the code for inserting the checkbox:

    [VBA]Private Sub BtnConcilBanc_Click()

    Dim langue As String
    Dim wsSheet As Worksheet
    On Error Resume Next
    Set wsSheet = Sheets("Conciliation_Bancaire")
    On Error GoTo 0
    Dim c As Range
    Dim LastTrans As String
    Dim oSht As Worksheet
    Dim lastRow As Long, i As Long
    Dim strSearch As String
    Dim t As Long
    Dim aCell As Range
    Dim accountName As String

    Application.ScreenUpdating = False

    Set oSht = Sheets("Config")
    lastRow = oSht.Range("G" & Rows.Count).End(xlUp).Row
    langue = Worksheets("Config").Range("Language")
    LastTrans = "DataJGO!A2:" & Range("DataJGO!A65536").End(xlUp).Address
    Application.ScreenUpdating = False

    If Not wsSheet Is Nothing Then
    Sheets("Conciliation_Bancaire").Visible = True
    Else
    Sheets("Template_Conc_Bank").Visible = True
    Sheets("Template_Conc_Bank").Copy After:=ActiveWorkbook.Sheets("Template_Conc_Bank")
    Sheets("Template_Conc_Bank (2)").Select
    Sheets("Template_Conc_Bank (2)").Name = "Conciliation_Bancaire"
    'Sheets("Template_Conc_Bank").Visible = xlVeryHidden
    End If

    For Each c In Range(LastTrans).Cells
    'check if CT or DT
    If c.Offset(0, 30).Value = "001" _
    Or c.Offset(0, 30).Value = "007" _
    Or c.Offset(0, 30).Value = "010" Then
    Range("Conciliation_Bancaire!ConcLDebit").Select
    ActiveCell.Offset(-1).EntireRow.Select
    Selection.Rows.Insert
    ActiveCell.Offset(0, 2).Value = Application.WorksheetFunction.VLookup(c.Offset(0, 30).Value, Range(langue & "!LangTransType"), 3, False)
    ActiveCell.Offset(0, 4).Value = c.Offset(0, 11).Value

    ElseIf c.Offset(0, 30).Value = "002" _
    Or c.Offset(0, 30).Value = "008" _
    Or c.Offset(0, 30).Value = "009" Then
    Range("Conciliation_Bancaire!ConcLCredit").Select
    ActiveCell.Offset(-1).EntireRow.Select
    Selection.Rows.Insert
    ActiveCell.Offset(0, 2).Value = Application.WorksheetFunction.VLookup(c.Offset(0, 30).Value, Range(langue & "!LangTransType"), 3, False)
    ActiveCell.Offset(0, 4).Value = -c.Offset(0, 11).Value

    End If
    Next c
    'Clean unused lines:
    Range("Conciliation_Bancaire!ConcLDebit").Offset(-1, 0).Select
    ActiveCell.EntireRow.Select
    Selection.Rows.Delete
    Range("Conciliation_Bancaire!ConcLCredit").Offset(-1, 0).Select
    ' Group cells

    ActiveCell.EntireRow.Select
    Selection.Rows.Delete

    If Range(Range("Conciliation_Bancaire!ConcLDebit").Address & ":" & Range("Conciliation_Bancaire!ConcLDebit").End(xlUp).Address).Rows.Count > 2 Then
    Range(Range("Conciliation_Bancaire!ConcLDebit").Offset(-1, 0).Address & ":" & Range("Conciliation_Bancaire!ConcLDebit").Offset(-1, 0).End(xlUp).Address).Select
    Selection.Rows.Group
    End If

    If Range(Range("Conciliation_Bancaire!ConcLCredit").Address & ":" & Range("Conciliation_Bancaire!ConcLCredit").End(xlUp).Address).Rows.Count > 2 Then
    Range(Range("Conciliation_Bancaire!ConcLCredit").Offset(-1, 0).Address & ":" & Range("Conciliation_Bancaire!ConcLCredit").Offset(-1, 0).End(xlUp).Address).Select
    Selection.Rows.Group
    End If


    'Partie au relevé de compte
    For Each c In Range(LastTrans).Cells
    strSearch = c.Offset(0, 6).Value
    Set aCell = oSht.Range("G1:G" & lastRow).Find(what:=strSearch, LookIn:=xlValues, _
    lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)

    If Not aCell Is Nothing Then
    accountName = Range("Config!" & aCell.Address).Offset(0, -1).Value
    Else
    accountName = ""
    End If
    'check if CT or DT
    If c.Offset(0, 30).Value = "001" _
    Or c.Offset(0, 30).Value = "007" _
    Or c.Offset(0, 30).Value = "010" Then
    Range("Conciliation_Bancaire!ConcBDebit").Select
    ActiveCell.Offset(-1).EntireRow.Select
    Selection.Rows.Insert
    ActiveCell.Offset(0, 2).Value = Application.WorksheetFunction.VLookup(c.Offset(0, 30).Value, Range(langue & "!LangTransType"), 3, False)
    ActiveCell.Offset(0, 4).Value = c.Offset(0, 11).Value

    ElseIf c.Offset(0, 30).Value = "008" _
    Or c.Offset(0, 30).Value = "009" Then
    Range("Conciliation_Bancaire!ConcBCredit").Select
    ActiveCell.Offset(-1).EntireRow.Select
    Selection.Rows.Insert
    ActiveCell.Offset(0, 2).Value = Application.WorksheetFunction.VLookup(c.Offset(0, 30).Value, Range(langue & "!LangTransType"), 3, False)
    ActiveCell.Offset(0, 4).Value = -c.Offset(0, 11).Value

    ElseIf c.Offset(0, 30).Value = "002" Then
    Range("Conciliation_Bancaire!ConcBCredit").Select
    ActiveCell.Offset(-1).EntireRow.Select
    Selection.Rows.Insert
    ActiveSheet.CheckBoxes.Add(ActiveCell.Offset(0, 2).Left, ActiveCell.Offset(0, 2).Top, ActiveCell.Offset(0, 2).Width, ActiveCell.Offset(0, 2).Height).Select
    With Selection
    .LinkedCell = ActiveCell.Offset(0, 2).Address
    .Characters.Text = c.Offset(0, 28).Value
    .Name = c.Offset(0, 28).Value
    .OnAction = "Macro1"
    End With
    ActiveCell.Offset(0, 2).Name = "Check" & c.Offset(0, 28).Value
    Range("Conciliation_Bancaire!NoChrCirc").Offset(2).EntireRow.Select
    Selection.Rows.Insert
    ActiveCell.Offset(0, 1).Value = c.Offset(0, 28).Value
    ActiveCell.Offset(0, 2).Value = -c.Offset(0, 11).Value
    ActiveCell.Offset(0, 1).Name = "ChkCirc" & c.Offset(0, 28).Value
    End If
    Next c

    'Clean unused lines:
    Range("Conciliation_Bancaire!ConcBDebit").Offset(-1, 0).Select
    ActiveCell.EntireRow.Select
    Selection.Rows.Delete
    Range("Conciliation_Bancaire!ConcBCredit").Offset(-1, 0).Select
    ' Group cells

    ActiveCell.EntireRow.Select
    Selection.Rows.Delete

    If Range(Range("Conciliation_Bancaire!ConcBDebit").Address & ":" & Range("Conciliation_Bancaire!ConcBDebit").End(xlUp).Address).Rows.Count > 2 Then
    Range(Range("Conciliation_Bancaire!ConcBDebit").Offset(-1, 0).Address & ":" & Range("Conciliation_Bancaire!ConcBDebit").Offset(-1, 0).End(xlUp).Address).Select
    Selection.Rows.Group
    End If

    If Range(Range("Conciliation_Bancaire!ConcBCredit").Address & ":" & Range("Conciliation_Bancaire!ConcBCredit").End(xlUp).Address).Rows.Count > 2 Then
    Range(Range("Conciliation_Bancaire!ConcBCredit").Offset(-1, 0).Address & ":" & Range("Conciliation_Bancaire!ConcBCredit").Offset(-1, 0).End(xlUp).Address).Select
    Selection.Rows.Group
    End If
    Application.ScreenUpdating = True

    End Sub[/VBA]

    and here is the code in the called macro:

    [VBA]Sub Macro1()

    Dim ChkbxName As String
    Dim chkbxState As String
    Dim n As Long
    Dim c As Range
    Dim LastTrans As String
    Dim oSht As Worksheet
    Dim lastRow As Long, i As Long
    Dim strSearch As String
    Dim aCell As Range
    Dim CheckAmmount As String

    ChkbxName = ActiveSheet.Shapes(Application.Caller).Name
    chkbxState = ActiveSheet.Shapes(ChkbxName).ControlFormat.Value
    Set oSht = Sheets("DataJGO")
    lastRow = oSht.Range("A" & Rows.Count).End(xlUp).Row
    strSearch = ChkbxName
    Set aCell = oSht.Range("AC1:AC" & lastRow).Find(what:=strSearch, LookIn:=xlValues, _
    lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)

    If Not aCell Is Nothing Then
    CheckAmmount = Range("DataJGO!" & aCell.Address).Offset(0, -17).Value
    Else
    CheckAmmount = ""
    End If

    If chkbxState = xlOn Then
    ActiveSheet.Range("Check" & ChkbxName).Offset(0, 2) = -CheckAmmount
    Range("ChkCirc" & ChkbxName).EntireRow.Select
    Selection.Rows.Delete
    Else
    ActiveSheet.Range("Check" & ChkbxName).Offset(0, 2) = ""
    Range("Conciliation_Bancaire!NoChrCirc").Offset(2).EntireRow.Select
    Selection.Rows.Insert
    ActiveCell.Offset(0, 1).Value = ChkbxName
    ActiveCell.Offset(0, 2).Value = -CheckAmmount
    ActiveCell.Offset(0, 1).Name = "ChkCirc" & ChkbxName
    End If
    End Sub[/VBA]

    now just need to find the button to mark this as solved

  6. #6
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

Posting Permissions

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