PDA

View Full Version : Formula excel Combining to cells



Salle3
03-29-2015, 09:37 AM
is there someone who can help with a formula


See the attached picture: pray2:

Yongle
03-29-2015, 02:31 PM
I am sure that it would be possible, but I am not sure I understand what your question is asking.
Are you wanting the value in column B to be expressed as a percentage of all the values for that type.

C2 = B2 divided by (B2+B5+B7) (as %)
C5 = B5 divided by (B2+B5+B7)
C4 is 100% because only one type C
etc
Is this what you want?

Yongle
03-30-2015, 01:24 AM
Is this what you want?
Values in % column are calculated by dividing value in column B by the total for all the same item - so 8.3% is 100 divided by total of all the red numbers (= total of TypeC) etc

13097

If so, see macro below and spreadsheet attached

How it works
1 create a temporary sheet
2 copy values in column1 to temporary sheet
3 remove duplicates so that we only have each item once
4 then calculate total for each item and put in column B of temporary sheet
5 put formula in columnC of original sheet, formatting cell as %
6 delete temporary sheet



Sub ColumnC_Percentages()


'declare variables
Dim i As Integer, j As Integer
Dim LastRowA As Long, LastRowB As Long, SubTotal As Long
Dim tmpSht As Worksheet, ws1 As Worksheet
Dim RangeA As Range, RangeB As Range

'determine last row, create temporary worksheet, and set ranges
Set ws1 = ActiveSheet
LastRowA = ws1.Range("A1").End(xlDown).Row
Set RangeA = ws1.Range("A2:A" & LastRowA)
Set tmpSht = ThisWorkbook.Worksheets.Add
LastRowB = tmpSht.Range("A1").End(xlDown).Row
Set RangeB = tmpSht.Range("A1:A" & LastRowA - 1) '-1 because starts A2 not A1


'copy values to temporary sheet and remove duplicates to obtain unique values
RangeA.Copy
RangeB.PasteSpecial xlPasteAll
tmpSht.Columns(1).RemoveDuplicates Columns:=Array(1)


'set range of those unique values
LastRowB = tmpSht.Range("A1").End(xlDown).Row

'create subtotals by item
For i = 1 To LastRowB
For j = 2 To LastRowA
If tmpSht.Cells(i, 1) = ws1.Cells(j, 1) Then
SubTotal = SubTotal + ws1.Cells(j, 2).Value
End If
Next j
tmpSht.Cells(i, 2) = SubTotal
SubTotal = 0
Next i

'create percentages in column C
For j = 2 To LastRowA
For i = 1 To LastRowB

If ws1.Cells(j, 1) = tmpSht.Cells(i, 1) Then
ws1.Cells(j, 3) = ws1.Cells(j, 2) / tmpSht.Cells(i, 2)
ws1.Cells(j, 3).NumberFormat = "0.0%"
End If
Next i
Next j

'delete temporary sheet
Application.DisplayAlerts = False
tmpSht.Delete
Application.DisplayAlerts = True

End Sub

Salle3
03-30-2015, 01:27 AM
I am sure that it would be possible, but I am not sure I understand what your question is asking.
Are you wanting the value in column B to be expressed as a percentage of all the values for that type.

C2 = B2 divided by (B2+B5+B7) (as %)
C5 = B5 divided by (B2+B5+B7)
C4 is 100% because only one type C
etc
Is this what you want?



OK, thank you for a quick reply
Let me give a eksemple:
1. excel should register how many types there are in Column 1 (In our case, there are 3 types, Type A, B and C)
2. For all types it must take the value of B (in our case the XB)
3. In Column 3 it must add the percent sign (%) and finally a number of types (ie. for type A =%XB1, Type B =%XB2 and type C =%XB3)


Does it make sense now?:yes

jonh
03-30-2015, 02:36 AM
[C2] ="%" & B2 & CODE(RIGHT(A2,1))-96

Salle3
03-30-2015, 03:33 AM
[C2] ="%" & B2 & CODE(RIGHT(A2,1))-96





Hey John

Thank you, but it's still not working. (="%" & B2 & CODE(RIGHT(A2;1))-96)
Plz See the attachment

Yongle
03-30-2015, 03:41 AM
@jonh - I had not even noticed the existence of the Code function - and what a simple way to turn alpha to numeric. So useful. :thumb

Yongle
03-30-2015, 03:49 AM
@Salle3 (http://www.vbaexpress.com/forum/member.php?56251-Salle3)

CHANGE

[C2] ="%" & B2 & CODE(RIGHT(A2,1))-96

TO

[C2] ="%" & B2 & CODE(RIGHT(A2,1))-64


use 96 for LowerCase

use 64 for UpperCase

Yongle
03-30-2015, 03:55 AM
or convert to lower case first and use the original formula

[C2] ="%" & B2 & CODE(LOWER(RIGHT(A2,1)))-96

jonh
03-30-2015, 04:16 AM
oops. sorry, i should have thought of that :)

Salle3
03-30-2015, 05:32 AM
or convert to lower case first and use the original formula

[C2] ="%" & B2 & CODE(LOWER(RIGHT(A2,1)))-96





Thank you all.
It works now, but it still does not solve my problem.:crying:
When I change names in Column A, Then my code switch to completely different numbers :banghead::help
See the picture:

jonh
03-30-2015, 07:08 AM
For that I think you do need code.
Put this in a standard module and run FillCollC


Public Sub FillCollC()
Dim ary() As String
ReDim ary(0)
i = 1
With ActiveSheet
Do
i = i + 1
If .Cells(i, 1) = "" Then Exit Do
.Cells(i, 3) = "%" & .Cells(i, 2) & ar(.Cells(i, 1), ary)
Loop
End With
End Sub

Private Function ar(val As String, ary() As String) As Integer
For i = 0 To UBound(ary)
If ary(i) = val Then
ar = i
Exit Function
End If
Next
ReDim Preserve ary(i)
ary(i) = val
ar = i
End Function

Salle3
03-30-2015, 12:29 PM
Wawwwww, this is Greate :-)
Thank you!

a little more question.
What to do If The data from column 1 and Column 2 is from other Sheet?

jonh
03-31-2015, 02:33 AM
This lets you set the source and destination sheets and which column is written to.


Public Sub EXAMPLE()
FillCollC Sheets("Sheet2"), ActiveSheet, 3
End Sub


Public Sub FillCollC(src As Worksheet, tgt As Worksheet, tgtcol As Integer)
Dim ary() As String
ReDim ary(0)
i = 1
Do
i = i + 1
If src.Cells(i, 1) = "" Then Exit Do
tgt.Cells(i, tgtcol) = "%" & src.Cells(i, 2) & ar(src.Cells(i, 1), ary)
Loop
End Sub

Private Function ar(val As String, ary() As String) As Integer
For i = 0 To UBound(ary)
If ary(i) = val Then
ar = i
Exit Function
End If
Next
ReDim Preserve ary(i)
ary(i) = val
ar = i
End Function