accounting excel worksheet problem

[bpascal123]

Hello,

Please find below a worksheet event script that basically looks up values in a chart of account (that I currently can't provide) and I would like to be able to select the validation list another time after the user makes a first choice and this will update the cell on the right or on the left.
 
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
If DIS_EVENT = True Then Exit Sub
 
'This below reads the cell validation list and first deletes the current validation
'and then perform a look up on the chart of accounts worksheet and update
'the cell next to it with the look up value
 
On Error Resume Next
With Target
  If AUTREOP_MODE = False Then
    If .Address = "$" & COL_COMPTENO_Y & "$" & LIG_DR And Range(COL_COMPTEINTITULE_Y & LIG_DR).Value Like vbNullString Then
      If Not .Value Like vbNullString Then
        Range(COL_COMPTEINTITULE_Y & LIG_DR).Validation.Delete
        Range(COL_COMPTEINTITULE_Y & LIG_DR).Formula = "=VLOOKUP( " & COL_COMPTENO_Y & LIG_DR & ",PCG,2,0)"
      End If
    End If
    
    If .Address = "$" & COL_COMPTEINTITULE_Y & "$" & LIG_DR And Range(COL_COMPTENO_Y & LIG_DR).Value Like vbNullString Then
      If Not .Value Like vbNullString Then
        Range(COL_COMPTENO_Y & LIG_DR).Validation.Delete
        Range(COL_COMPTENO_Y & LIG_DR).Formula = "=INDEX(PCG_ACC,MATCH(" & COL_COMPTEINTITULE_Y & LIG_DR & ",PCG_LIB,0))"
      End If
    End If
 
   'GL MODE
  ElseIf AUTREOP_MODE = True Then
     
    If .Address = "$" & COL_COMPTENO_Y & "$" & LIG_DR And Range(COL_COMPTEINTITULE_Y & LIG_DR).Value Like vbNullString Then
     
       If Not .Value Like vbNullString Then
         Range(COL_COMPTEINTITULE_Y & LIG_DR).Validation.Delete
         Range(COL_COMPTEINTITULE_Y & LIG_DR).Formula = "=VLOOKUP( " & COL_COMPTENO_Y & LIG_DR & ",PCG,2,0)"
       End If
    End If
   
     If .Address = "$" & COL_COMPTEINTITULE_Y & "$" & LIG_DR And Range(COL_COMPTENO_Y & LIG_DR).Value Like vbNullString Then
       If Not .Value Like vbNullString Then
         Range(COL_COMPTENO_Y & LIG_DR).Validation.Delete
         Range(COL_COMPTENO_Y & LIG_DR).Formula = "=INDEX(PCG_ACC,MATCH(" & COL_COMPTEINTITULE_Y & LIG_DR & ",PCG_LIB,0))"
       End If
     End If
     
    End If
    
    If .Address = "$" & COL_COMPTENO_Y & "$" & LIG_CR And Range(COL_COMPTEINTITULE_Y & LIG_CR).Value Like vbNullString Then
     
       If Not .Value Like vbNullString Then
         Range(COL_COMPTEINTITULE_Y & LIG_CR).Validation.Delete
         Range(COL_COMPTEINTITULE_Y & LIG_CR).Formula = "=VLOOKUP( " & COL_COMPTENO_Y & LIG_CR & ",PCG,2,0)"
       End If
    End If
   
     If .Address = "$" & COL_COMPTEINTITULE_Y & "$" & LIG_CR And Range(COL_COMPTENO_Y & LIG_CR).Value Like vbNullString Then
       If Not .Value Like vbNullString Then
         Range(COL_COMPTENO_Y & LIG_CR).Validation.Delete
         Range(COL_COMPTENO_Y & LIG_CR).Formula = "=INDEX(PCG_ACC,MATCH(" & COL_COMPTEINTITULE_Y & LIG_CR & ",PCG_LIB,0))"
       End If
       
     End If
     
End With
 
End Sub

Please advise on this or any thoughts,

Pascal

[bpascal123]

This is a French charts of accounts that I am not currently able to provide

[Vaibhav Joshi]

why dont you share few lines...

On Sat, Feb 28, 2015 at 6:54 PM, bpascal123 <bpasc...@gmail.com> wrote:

This is a French charts of accounts that I am not currently able to provide

--
----------------------------------------------------------------------------------------------------------------------
You received this message because you are subscribed to the Google
Groups "Excel VBA Codes & Macros" group.
 
To post to this group, send email to
excelvb...@googlegroups.com
 
To unsubscribe from this group, send email to
excelvbamacro...@googlegroups.com
 
For more options, visit this group at
http://groups.google.com/group/excelvbamacros
---
You received this message because you are subscribed to the Google Groups "Excel VBA Macros" group.
To unsubscribe from this group and stop receiving emails from it, send an email to excelvbamacro...@googlegroups.com.
To post to this group, send email to excelvb...@googlegroups.com.
Visit this group at http://groups.google.com/group/excelvbamacros.
For more options, visit https://groups.google.com/d/optout.

[bpascal123]

This is a multipart project and I am just in charge implementing the worksheet function vlookup, index and match using worksheet events

[bpascal123]

Vabz,

Vabz, 

I feel I can provide more infos:

This is the global variables, COA stands for CHARTS OF ACCOUNTS, same as PCG

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'START COA CONST COLUMNS

Public Const COA_DIV_CPTE As Byte = 4

Public Const COA_NUM_CPTE As Byte = 5

Public Const COA_INT_CPTE As Byte = 6

Public Const COA_TYPE_CPTE As Byte = 7

Public Const COA_CAT_CPTE As Byte = 8

'END COA CONST COLUMNS

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'START INPUT TO THE JOURNAL

'

Public Const LIG_DIV_VAL As Byte = 4

Public Const COL_DIV_VAL As Byte = 6

Public Const LIG_DR As Byte = 7

Public Const LIG_CR As Byte = 8

'Public Const LIG_INS As Byte = 15

Public Const COL_NO_Y As String = "B"

Public Const COL_NO As Byte = 2

Public Const COL_DATE_Y As String = "C"

Public Const COL_DATE As Byte = 3

Public Const COL_TYPE_Y As String = "D"

Public Const COL_TYPE As Byte = 4

Public Const COL_COMPTENO_Y As String = "E"

Public Const COL_COMPTENO As Byte = 5

Public Const COL_COMPTEINTITULE_Y As String = "F"

Public Const COL_COMPTEINTITULE As Byte = 6

Public Const COL_COMPTELIBELLE_Y As String = "G"

Public Const COL_COMPTELIBELLE As Byte = 7

Public Const COL_SPACE_Y As String = "H"

Public Const COL_SPACE As Byte = 8

Public Const COL_DEBIT_Y As String = "I"

Public Const COL_DEBIT As Byte = 9

Public Const COL_CREDIT_Y As String = "J"

Public Const COL_CREDIT As Byte = 10

Public Const COL_REFERENCE_Y As String = "K"

Public Const COL_REFERENCE As Byte = 11

Public Const COL_LETTRAGE_Y As String = "L"

Public Const COL_LETTRAGE As Byte = 12

Public Const COL_HIDDENCLNO_Y As String = "M"

Public Const COL_HIDDENCLNO As Byte = 13

Public Const COL_HIDDENCLNM_Y As String = "N"

Public Const COL_HIDDENCLNM As Byte = 14

'

'END INPUT TO THE JOURNAL

'

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public AUTREOP_MODE As Boolean ''Autre op' wks event global parameter

Public BTN As Byte

Public CPTA_MODE As Boolean '0 Treso - 1 Accruals

Public DIS_EVENT As Boolean 'force disabling event

Public lastr As Long 

and following is the module in charge of supplying validation list data

Sub SaisieJal(w As Worksheet, P_BTN As Byte, CPTA_MODE As Boolean)

'

'w for worksheet

'p_mode for single or multiple entry type transaction

'p_mode 0 = single entry, 1 = multiple entries

'p_btn for expense = 1 revenue = 2, other = 3

'p_cpta for tresorerie or engagement 0 = treso, 1 = engagement

'

Dim vList As Variant

Dim r As Range

Dim i As Long, j As Long

'On Error Resume Next

Select Case CPTA_MODE 'CASH ACCOUNTING

  Case False

    

    With w

  

      Select Case P_BTN 'Top buttons

        

        Case 1 'Cash accounting - EXPENSE

          Set ws_COA = ThisWorkbook.Worksheets(wsCoa)

          'Accounts

          vList = RetAccValList(ws_COA, P_BTN, COA_NUM_CPTE, COA_CAT_CPTE) 'cf function 1 for accounts

          

          With .Cells(LIG_DR, COL_COMPTENO).Validation

            .Delete

            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _

              xlBetween, Formula1:=Join(vList, ",") 'update

            .IgnoreBlank = True

            .InCellDropdown = True

            .ShowInput = True

            .ShowError = True

          End With

          

          'Labels

          vList = RetAccValList(ws_COA, P_BTN, COA_INT_CPTE, COA_CAT_CPTE) 'cf function 1 for accounts

                    

          With .Cells(LIG_DR, COL_COMPTEINTITULE).Validation

            .Delete

            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _

            xlBetween, Formula1:=Join(vList, ",") 'update

            .IgnoreBlank = True

            .InCellDropdown = True

            .ShowInput = True

            .ShowError = False

          End With

          'Credit ready available bank accounts nb

          vList = RetAccValList(ws_COA, 4, COA_NUM_CPTE, COA_TYPE_CPTE) 'cf function 1 for accounts

                    

          With .Cells(LIG_CR, COL_COMPTENO).Validation

            .Delete

            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _

            xlBetween, Formula1:=Join(vList, ",") 'update

            .IgnoreBlank = True

            .InCellDropdown = True

            .ShowInput = True

            .ShowError = False

          End With

          

          .Cells(LIG_CR, COL_COMPTENO).Value = vList(0)

          'DIS_EVENT = True

           'Credit ready available bank accounts labels

          vList = RetAccValList(ws_COA, 4, COA_INT_CPTE, COA_TYPE_CPTE) 'cf function 1 for accounts

                    

          With .Cells(LIG_CR, COL_COMPTEINTITULE).Validation

            .Delete

            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _

            xlBetween, Formula1:=Join(vList, ",") 'update

            .IgnoreBlank = True

            .InCellDropdown = True

            .ShowInput = True

            .ShowError = False

          End With

            

          .Cells(LIG_CR, COL_COMPTEINTITULE).Formula = "=VLOOKUP( " & COL_COMPTENO_Y & LIG_CR & ",PCG,2,0)"

          

          With .Cells(LIG_CR, COL_DEBIT).Interior

            .Pattern = xlChecker

            .PatternColor = 5296274

            .ThemeColor = xlThemeColorDark1

            .TintAndShade = -4.99893185216834E-02

            .PatternTintAndShade = 0

          End With

          

          With .Cells(LIG_DR, COL_CREDIT).Interior

            .Pattern = xlChecker

            .PatternColor = 5296274

            .ThemeColor = xlThemeColorDark1

            .TintAndShade = -4.99893185216834E-02

            .PatternTintAndShade = 0

          End With

        

          Set ws_COA = Nothing

      

         Case 2 'Cash accounting - REVENUE

          Set ws_COA = ThisWorkbook.Worksheets(wsCoa)

          'Accounts

          vList = RetAccValList(ws_COA, P_BTN, COA_NUM_CPTE, COA_CAT_CPTE) 'cf function 1 for accounts

          

          With .Cells(LIG_CR, COL_COMPTENO).Validation

            .Delete

            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _

              xlBetween, Formula1:=Join(vList, ",") 'update

            .IgnoreBlank = True

            .InCellDropdown = True

            .ShowInput = True

            .ShowError = True

          End With

      

           'Labels

          vList = RetAccValList(ws_COA, P_BTN, COA_INT_CPTE, COA_CAT_CPTE) 'cf function 1 for accounts

                    

          With .Cells(LIG_CR, COL_COMPTEINTITULE).Validation

            .Delete

            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _

            xlBetween, Formula1:=Join(vList, ",") 'update

            .IgnoreBlank = True

            .InCellDropdown = True

            .ShowInput = True

            .ShowError = False

          End With

      

         'Credit ready available bank accounts nb

          vList = RetAccValList(ws_COA, 4, COA_NUM_CPTE, COA_TYPE_CPTE) 'cf function 1 for accounts

                    

          With .Cells(LIG_DR, COL_COMPTENO).Validation

            .Delete

            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _

            xlBetween, Formula1:=Join(vList, ",") 'update

            .IgnoreBlank = True

            .InCellDropdown = True

            .ShowInput = True

            .ShowError = False

          End With

          

          .Cells(LIG_DR, COL_COMPTENO).Value = vList(0)

          'DIS_EVENT = True

           'Credit ready available bank accounts labels

          vList = RetAccValList(ws_COA, 4, COA_INT_CPTE, COA_TYPE_CPTE) 'cf function 1 for accounts

                    

          With .Cells(LIG_DR, COL_COMPTEINTITULE).Validation

            .Delete

            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _

            xlBetween, Formula1:=Join(vList, ",") 'update

            .IgnoreBlank = True

            .InCellDropdown = True

            .ShowInput = True

            .ShowError = False

          End With

            

          .Cells(LIG_DR, COL_COMPTEINTITULE).Formula = "=VLOOKUP( " & COL_COMPTENO_Y & LIG_DR & ",PCG,2,0)"

 

          .Cells(LIG_DR, COL_DEBIT).Interior.Pattern = xlSolid

          .Cells(LIG_CR, COL_CREDIT).Interior.Pattern = xlSolid

          

          .Cells(LIG_DR, COL_CREDIT).Interior.Pattern = xlGray25

          .Cells(LIG_CR, COL_DEBIT).Interior.Pattern = xlGray25

        

           With .Cells(LIG_DR, COL_CREDIT).Interior

            .Pattern = xlChecker

            .PatternColor = 12611584

            .ThemeColor = xlThemeColorDark1

            .TintAndShade = -4.99893185216834E-02

            .PatternTintAndShade = 0

          End With

          

          With .Cells(LIG_CR, COL_DEBIT).Interior

            .Pattern = xlChecker

            .PatternColor = 12611584

            .ThemeColor = xlThemeColorDark1

            .TintAndShade = -4.99893185216834E-02

            .PatternTintAndShade = 0

          End With

          Set ws_COA = Nothing

      

        Case 3 'Cash accounting - OTHER OPERATIONS

          Set ws_COA = ThisWorkbook.Worksheets(wsCoa)

          'Accounts

          vList = RetAccValList(ws_COA, P_BTN, COA_NUM_CPTE, COA_CAT_CPTE) 'cf function 1 for accounts

          

          With .Cells(LIG_CR, COL_COMPTENO).Validation

            .Delete

            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _

              xlBetween, Formula1:=Join(vList, ",") 'update

            .IgnoreBlank = True

            .InCellDropdown = True

            .ShowInput = True

            .ShowError = True

          End With

      

           With .Cells(LIG_DR, COL_COMPTENO).Validation

            .Delete

            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _

              xlBetween, Formula1:=Join(vList, ",") 'update

            .IgnoreBlank = True

            .InCellDropdown = True

            .ShowInput = True

            .ShowError = True

          End With

           'Labels

          vList = RetAccValList(ws_COA, P_BTN, COA_INT_CPTE, COA_CAT_CPTE) 'cf function 1 for accounts

                    

          With .Cells(LIG_CR, COL_COMPTEINTITULE).Validation

            .Delete

            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _

            xlBetween, Formula1:=Join(vList, ",") 'update

            .IgnoreBlank = True

            .InCellDropdown = True

            .ShowInput = True

            .ShowError = False

          End With

      

           With .Cells(LIG_DR, COL_COMPTEINTITULE).Validation

            .Delete

            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _

            xlBetween, Formula1:=Join(vList, ",") 'update

            .IgnoreBlank = True

            .InCellDropdown = True

            .ShowInput = True

            .ShowError = False

          End With

          .Cells(LIG_DR, COL_DEBIT).Interior.Pattern = xlSolid

          .Cells(LIG_CR, COL_CREDIT).Interior.Pattern = xlSolid

          

          .Cells(LIG_DR, COL_CREDIT).Interior.Pattern = xlGray25

          .Cells(LIG_CR, COL_DEBIT).Interior.Pattern = xlGray25

        

          Set ws_COA = Nothing

      

      

    End Select

  End With

  End Select

With w

  

  Set r = .Range("E15")

  Range(r, r.End(xlDown)).TextToColumns Destination:=Range("E15"), DataType:=xlDelimited, _

      TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _

      Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _

      :=Array(1, 1), TrailingMinusNumbers:=True

  Set r = Nothing

End With

End Sub

Function RetAccValList(w As Worksheet, Mod_Cpte As Byte, CoaCol As Byte, LkUpCol As Byte) As Variant

'

'Mod_Cpte = expense/revenue/bilan

'CoaCol = Col nb from COA ws

'LkUpCol = look col on COA

'

'

  Dim v() As String

  Dim acc_type As String

  Dim i As Long, j As Long, k As Long

  Dim lastr As Long

  

  Select Case Mod_Cpte

    Case 1

      acc_type = Exp

    Case 2

      acc_type = Rev

    Case 3

      acc_type = BalSheet

    Case 4

      acc_type = treso

  End Select

  

  With w

    ReDim v(0)

    lastr = .Cells(Rows.Count, 3).End(xlUp).Row

    k = 0

    For i = 3 To lastr

        If LCase(.Cells(i, LkUpCol).Value) Like acc_type Then

          v(k) = CStr(.Cells(i, CoaCol).Value)

          k = k + 1

          ReDim Preserve v(k)

        End If

    Next i

  End With

  

  ReDim Preserve v(k - 1)

  RetAccValList = v

End Function

I might be able to provide more infos in the futur,

Pascal

[bpascal123]

Maybe later, I should be able to post the whole file so you can put this code back together and run a small accounting excel application and maybe see for me where there should be improvements.