PDA

View Full Version : merge ajacent cells



lior03
08-10-2007, 11:57 AM
hello
i built a macro for a large data base.i wanted to merge two cells.

Dim lngRow As Long
Dim lngcom As Long
Dim firRow As Long
ActiveSheet.ResetAllPageBreaks
lngRow = ActiveSheet.Range("a1").End(xlDown).row
firRow = ActiveSheet.Range("a1").End(xlToRight).row
lngcom = ActiveSheet.Range("a1").End(xlToRight).Column
With Cells(lngRow + 2, lngcom - 2)
.clear
.Value = Format(Now, "dd/mm/yyyy hh:mm:ss dddd")
Range(Cells(lngRow + 2, lngcom - 2).Cells(lngRow + 2, lngcom - 3)).Merge
End With
With Cells(lngRow + 2, lngcom - 1)
.Value = "total items on list:"
With Cells(lngRow + 2, lngcom)
clear
.FormulaR1C1 = "=SUBTOTAL(3,(R2C:R[-1]C))"
.NUMBERFORMAT = "#,###0"
.Font.ColorIndex = 3
End With
With ActiveSheet.pagesetup
.CenterHorizontally = True
.PrintArea = "$A$2:" & Cells(lngRow + 2, lngcom).Address
.PrintTitleRows = "$A$1:" & Cells(firRow, lngcom).Address
.PrintGridlines = True
.Orientation = xlPortrait
.PrintComments = xlPrintInPlace
.CenterFooter = "&P of &N pages"
.CenterHeader = "&A" & "-" & "&F"
.RightFooter = ""
.RightHeader = ""
.LeftHeader = "&t" & Chr(13) & "&D"
.zoom = 90
End With
End With
Dim i As Integer
For i = 50 To Range("A1").End(xlDown).row Step 50
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Rows(i + 1)
Next i

i wanted the the date and hour cell be merge with rthe cell next to it from the left.i try to use the cell method .
thanks

mdmackillop
08-10-2007, 12:39 PM
At the risk of being thrown out of the club for showing how to merge cells, try
With Cells(lngRow + 2, lngcom - 2)
.MergeArea.Clear
.Value = Format(Now, "dd/mm/yyyy hh:mm:ss dddd")
Cells(lngRow + 2, lngcom - 3).Resize(, 2).MergeCells = True
End With
BTW I think you'll find that firRow will always = 1

lior03
08-11-2007, 12:29 AM
Application.ScreenUpdating = False
On Error GoTo err
Dim Num As Integer
Dim oVBC As Object
Dim Wb As Workbook
Dim i As Integer
Application.StatusBar = "leghty macro ,please wait"
x = 2
For Each Wb In Workbooks
Sheets("projects").Activate
Cells.clear
For Each oVBC In Workbooks(Wb.name).VBProject.VBComponents
If Workbooks(Wb.name).VBProject.Protection = vbext_pp_none Then
Call GetCodeRoutines(Wb.name, oVBC.name)
End If
Next
Next
With Sheets("projects")
.[A1].Resize(, 4).Value = Array("Workbook", "Module", "Procedures", "number")
.[A2].Resize(UBound(aList, 2), UBound(aList, 1)).Value = _
Application.Transpose(aList)
.Columns("A:D").Columns.autofit
With Cells
.Font.Bold = True
.HorizontalAlignment = xlLeft
Application.StatusBar = ""
Cells.clearcomments
Cells.Font.ColorIndex = 1
Dim lngRow As Long
Dim lngcom As Long
lngRow = ActiveSheet.Range("a1").End(xlDown).row
lngcom = ActiveSheet.Range("a1").End(xlToRight).Column
Cells(lngRow + 2, lngcom).FormulaR1C1 = "=countA(R2C:R[-1]C)"
Cells(lngRow + 2, lngcom).NUMBERFORMAT = "#,###0"
For i = 2 To lngRow
Cells(i, lngcom).FormulaR1C1 = "=rows(R1C:R[-1]C)"
Cells(i, lngcom).NUMBERFORMAT = "#,###0"
Exit Sub
err:
If err.number = 9 Then
Sheets.Add.name = "projects"
End If
Next
End With
End With
Application.ScreenUpdating = True

hello
my data base consists of all macros in a workbook.how can i drag and autofill the fourth column?
thanks

mdmackillop
08-11-2007, 09:11 AM
I don't really understand what you mean.
Anyway, you don't need to loop to fill your formulae as shown. Use
With Range(Cells(2, lngcom), Cells(lngRow, lngcom))
.FormulaR1C1 = "=rows(R1C:R[-1]C)"
.NumberFormat = "#,###0"
End With

Exit Sub is stopping the loop in any case. Why?

austenr
08-11-2007, 05:34 PM
Merged cells are a bad idea especially if you are doing any manipulation to them.

lior03
08-13-2007, 10:03 AM
hello
is it possible to add at a footer the value of say cell D1 for every page.
thanks

austenr
08-13-2007, 10:12 AM
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) ActiveSheet.PageSetup.LeftFooter = Range("D1").TextEnd Sub

This goes in the Worksheet Selection Change event on the worksheet you want the footer to appear.

lior03
08-13-2007, 10:33 AM
if i have a column in a table containing a rows formula for the row number
and i want to add to each page a right header like - from (row) x to (row) y of each page. could it be doen?
thanks

Norie
08-13-2007, 12:06 PM
Is this actually connected to the original post?