# Deleting a row or column of an adjacency matrix while maintaining the associated label

I am currently working with a weighted adjacency matrix for a directed graph, and it contains several 0 columns and rows. With the unaltered matrix, I am able to monitor the relations between vertices with,

TableForm[Normal @ WeightedAdjacencyMatrix[graph],
TableHeadings -> {a = VertexList[graph], a}]


This outputs a table with the corresponding vertex list labeling the rows and columns. I want to delete the 0 rows and columns while altering the labels to reflect the change. My matrix is currently $85\times 85$, and eliminating the necessary rows and columns reduces the size to $77\times 38$. I could theoretically go through by hand and track the eliminated entries, but that sounds way too time consuming for something that I'm sure has a simple solution. Any help is appreciated.

-

graph= Graph[Range@5 , {1 -> 5, 5 -> 3, 3 -> 1}, EdgeWeight-> RandomInteger[100, 3]]

Grid[Transpose[
Select[Transpose[
Select[Join[{Join[{""}, VertexList[graph]]},
Total@Rest@# != 0 &]], Total@Rest@# != 0 &]],
Alignment -> Right, Dividers -> {{2 -> Red}, {2 -> Red}}];



-
nonzerorowsF = Function[{grph}, Pick[Range[VertexCount[grph]],
Tr@Abs[#] != 0 & /@ WeightedAdjacencyMatrix[grph]]];
nonzerocolsF = Function[{grph}, Pick[Range[VertexCount[grph]],
Tr@Abs[#] != 0 & /@ Transpose[WeightedAdjacencyMatrix[grph]]]];


example:

 options = Sequence[VertexStyle -> LightYellow,
VertexSize -> 0.2,
VertexLabels -> Placed["Name", {1/2, 1/2}],
VertexLabelStyle -> Directive[16, Red, Bold, Italic],
EdgeLabelStyle -> Directive[16, Blue, Bold],
ImageSize -> 350, EdgeStyle -> Blue];

ew = RandomReal[{-5, 5}, 4];
g = Graph[{3, 4, 5, 1, 2, 6},
{2 -> 3, 3 -> 1, 1 -> 2, 1 -> 4},
EdgeWeight -> ew, options,

rows = nonzerorowsF[g];