DATA Entry with Dimension

[VinodKrishnappa]

Hi...
I required little help in making an entry employee wise with the data available.

In a file, I'll be having 2 sheets DATA & ENTRY. I should use the DATA to make available of the ENTRY individual employee wise.

DATA Sheet

		DIMENTION PART 2 - TEXTS	DIMENSION PART 1 - LEDGER CODES
EMPLOYEE NO	NAME	BRANCH	BUSINESS UNIT	DEPARTMENT	EMPNO	PROJECT	SEGMENT	431208	132011	142014	142020	131401	142010	142017	251301	132001	431208	431208	132025
111000	Mr. A	DEL	General	HRM	111000	PROJ1	DSP	31,100	200	1,800	0	0	1,270	0	0	0	0	0	27,830
111001	Mr. B	PUN	General	ACC	111001	PROJ2	GES	31,200	200	1,800	0	466	0	0	100	0	0	0	28,734
111002	Ms. C	DEL	General	FCA	111002	PROJ1	GEN	27,400	200	1,800	0	0	233	0	0	0	0	0	25,167
								Amount
								Dr.	Cr.	Cr.	Cr.	Cr.	Cr.	Cr.	Cr.	Cr.	Cr.	Cr.	Cr.

<colgroup><col><col><col span="6"><col span="12"></colgroup><tbody>
</tbody>

Entry Sheet

DR	CR	DIMENSION
31100		431208.DEL.General.HRM.111000.PROJ1.DSP
	200	132011.DEL.General.HRM.111000.PROJ1.DSP
	1800	142014.DEL.General.HRM.111000.PROJ1.DSP
	1270	132036.DEL.General.HRM.111000.PROJ1.DSP
	27830	132025.DEL.General.HRM.111000.PROJ1.DSP
31200		431208.PUN.General.ACC.111001.PROJ2.GES
	200	132011.PUN.General.ACC.111001.PROJ2.GES
	1800	142014.PUN.General.ACC.111001.PROJ2.GES
	466	131401.PUN.General.ACC.111001.PROJ2.GES
	100	251301.PUN.General.ACC.111001.PROJ2.GES
	28734	132025.PUN.General.ACC.111001.PROJ2.GES
27400		431208.DEL.General.FCA.111002.PROJ1.GEN
	200	132011.DEL.General.FCA.111002.PROJ1.GEN
	1800	142014.DEL.General.FCA.111002.PROJ1.GEN
	233	142010.DEL.General.FCA.111002.PROJ1.GEN
	25167	132025.DEL.General.FCA.111002.PROJ1.GEN

<colgroup><col span="2"><col></colgroup><tbody>
</tbody>

Now in ENTRY sheet Dr. (Column A) & Cr. (Column B) will consist the amount of the individual employees line by line in a transpose way which comes from DATA.

Next to this we'll have Dimension (Column C) which consist the dimension of individual line item details as available in DATA sheet. The Format of the Dimension is mentioned in DATA Sheet for reference.

DIMENSION FORMAT
LEDGERCODE.BRANCH.BUSINESSUNIT.DEPARTMENT.EMPNO.PROJECT.SEGMENT
Dimension Part 1	Dimension Part 2
LEDGERCODE.	BRANCH.BUSINESSUNIT.DEPARTMENT.EMPNO.PROJECT.SEGMENT

<colgroup><col span="6"><col span="3"></colgroup><tbody>
</tbody>

Now in my requirement i need entry in ENTRY SHEET for all the employees from DATA sheet in a automated process. I'll be handling this for 1000 line items.

Please do the needful.
Thanks in advance.
VK

 

[wideboydixon]

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
1	DIMENSION PART 2 - TEXTS								DIMENSION PART 1 - LEDGER CODES
2	EMPLOYEE NO	NAME	BRANCH	BUSINESS UNIT	DEPARTMENT	EMPNO	PROJECT	SEGMENT	431208	132011	142014	142020	131401	142010	132017	251301	132001	321208	431208	132025
3	111000	Mr. A	DEL	General	HRM	111000	PROJ1	DSP	31100	200	1800	0	0	1270	0	0	0	0	0	27830
4	111001	Mr. B	PUN	General	ACC	111001	PROJ2	GES	31200	200	1800	0	466	0	0	100	0	0	0	28734
5	111002	Mr. C	DEL	General	FCA	111002	PROJ1	GEN	27400	200	1800	0	0	233	0	0	0	0	0	25167
DATA

Book1
	A	B	C
1	DR	CR	DIMENSION
2	31100		431208.DEL.General.HRM.111000.PROJ1.DSP
3		200	132011.DEL.General.HRM.111000.PROJ1.DSP
4		1800	142014.DEL.General.HRM.111000.PROJ1.DSP
5		1270	142010.DEL.General.HRM.111000.PROJ1.DSP
6		27830	132025.DEL.General.HRM.111000.PROJ1.DSP
7	31200		431208.PUN.General.ACC.111001.PROJ2.GES
8		200	132011.PUN.General.ACC.111001.PROJ2.GES
9		1800	142014.PUN.General.ACC.111001.PROJ2.GES
10		466	131401.PUN.General.ACC.111001.PROJ2.GES
11		100	251301.PUN.General.ACC.111001.PROJ2.GES
12		28734	132025.PUN.General.ACC.111001.PROJ2.GES
13	27400		431208.DEL.General.FCA.111002.PROJ1.GEN
14		200	132011.DEL.General.FCA.111002.PROJ1.GEN
15		1800	142014.DEL.General.FCA.111002.PROJ1.GEN
16		233	142010.DEL.General.FCA.111002.PROJ1.GEN
17		25167	132025.DEL.General.FCA.111002.PROJ1.GEN
ENTRY

Private Const HEADER_ROW = 2 ' Make this the row on the DATA sheet that contains the headers
Public Sub DataEntryWithDimension()

Dim wsData As Worksheet
Dim wsEntry As Worksheet
Dim lastRow As Long
Dim thisRow As Long
Dim lastCol As Long
Dim thisCol As Long
Dim nextRow As Long
Dim nextCol As Long
Dim dimensionParts(5) As Variant
Dim headerRange As Range
Dim dimensionString As String
Dim i As Long

' Get handles to the sheets
Set wsData = Worksheets("DATA")
Set wsEntry = Worksheets("ENTRY")

' Find the last row as column on the data sheet
lastRow = wsData.Cells(wsData.Rows.Count, 1).End(xlUp).Row
lastCol = wsData.Cells(HEADER_ROW, wsData.Columns.Count).End(xlToLeft).Column

' Set up the header range
Set headerRange = wsData.Range(wsData.Cells(HEADER_ROW, 1), wsData.Cells(HEADER_ROW, lastCol))

' Find the column headers for each constituent of the dimension
dimensionParts(0) = Application.Match("BRANCH", headerRange, 0)
dimensionParts(1) = Application.Match("BUSINESS UNIT", headerRange, 0)
dimensionParts(2) = Application.Match("DEPARTMENT", headerRange, 0)
dimensionParts(3) = Application.Match("EMPNO", headerRange, 0)
dimensionParts(4) = Application.Match("PROJECT", headerRange, 0)
dimensionParts(5) = Application.Match("SEGMENT", headerRange, 0)

' Find the next row on the entry sheet
nextRow = wsEntry.Cells(wsEntry.Rows.Count, 3).End(xlUp).Row + 1

' Process all rows on the data sheet
For thisRow = HEADER_ROW + 1 To lastRow
    ' This is the next column we'll fill on the entry sheet
    nextCol = 1
    
    ' Process all columns to the right of "SEGMENT" on the data sheet
    For thisCol = dimensionParts(5) + 1 To lastCol
        ' If this is a non-zero amount
        If wsData.Cells(thisRow, thisCol).Value > 0 Then
            ' Construct the dimension string from the appropriate columns
            dimensionString = CStr(wsData.Cells(HEADER_ROW, thisCol).Value)
            For i = 0 To 5
                dimensionString = dimensionString & "." & CStr(wsData.Cells(thisRow, dimensionParts(i)).Value)
            Next i
            
            ' Put the values into the next row
            wsEntry.Cells(nextRow, 3).Value = dimensionString
            wsEntry.Cells(nextRow, nextCol).Value = wsData.Cells(thisRow, thisCol).Value
            
            ' Move the next column to the right if necessary
            If nextCol < 2 Then nextCol = 2
            
            ' Move to the next row
            nextRow = nextRow + 1
        End If
    Next thisCol
Next thisRow

End Sub

WBD

 

[ttray33y]

maintenance wise, this is going to get missy as the data increases. 1000 lines of formula wooot.. You should consider redesigning your spreadsheet. just my opinion. anyway im on the challenge.

WBD already had a solution for you, im abandoning mine now. good luck bro.

 

[VinodKrishnappa]

Thank you... It worked.